-
Notifications
You must be signed in to change notification settings - Fork 11
/
ebdb.el
6201 lines (5484 loc) · 216 KB
/
ebdb.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; ebdb.el --- Contact management package -*- lexical-binding: t; -*-
;; Copyright (C) 2016-2024 Free Software Foundation, Inc.
;; Version: 0.8.22
;; Package-Requires: ((emacs "25.1") (seq "2.15"))
;; Maintainer: Eric Abrahamsen <[email protected]>
;; Author: Eric Abrahamsen <[email protected]>
;; Keywords: convenience mail
;; URL: https://github.com/girzel/ebdb
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package began as a port of the Insidious Big Brother Database
;; (by Jamie Zawinski and Roland Winkler) using EIEIO, Emacs' newish
;; object-orientation library. Eventually it developed to the point
;; where a separate package seemed to make most sense. But the basic
;; behavior of the package, and the look of the *EBDB* buffer, are
;; still very much indebted to the original library. Some of the
;; original files have been directly copied over and renamed -- where
;; applicable, the names of the authors of the original libraries have
;; been noted.
;; This file contains the basic data structures and behavior for EBDB,
;; including the class definitions for databases, records, and fields.
;; The order of appearance of code in this file is mostly determined
;; by the order in which the compiler wants to see things.
;;; Code:
(require 'timezone)
(require 'cl-lib)
(require 'seq)
(require 'map)
(require 'calendar)
(require 'subr-x)
(require 'pcase)
(require 'eieio)
(require 'eieio-base)
(require 'eieio-opt)
(require 'mailabbrev)
;; Pacify the compiler.
(autoload 'ebdb-i18n-countries "ebdb-i18n")
(autoload 'widget-group-match "wid-edit")
(autoload 'ebdb-migrate-from-bbdb "ebdb-migrate")
(autoload 'eieio-customize-object "eieio-custom")
(autoload 'diary-ordinal-suffix "diary-lib")
(autoload 'org-agenda-list "org-agenda")
(autoload 'org-make-tags-matcher "org")
(defvar ebdb-i18n-countries)
(defvar ebdb-i18n-countries-pref-scripts)
;; These are the most important internal variables, holding EBDB's
;; data structures.
(defvar ebdb-db-list nil
"The list of currently-loaded EBDB databases.")
(defvar ebdb-record-tracker nil
"A list of all the loaded records.")
(defvar ebdb-hashtable (make-hash-table :test #'equal)
"Hash table for EBDB records.
Hashes the fields first-last-name, last-first-name, organization, aka,
and mail.")
(defvar ebdb-org-hashtable (make-hash-table :size 500 :test #'equal)
"Hash table of role relationships.
Keys are string UUIDs of organizations. Values are lists
of (record-uuid . role-field). Hashtable entries are created and
deleted by the `ebdb-init-field' and `ebdb-delete-field' methods
of the `ebdb-field-role' field class.")
(defvar ebdb-relation-hashtable (make-hash-table :size 500 :test #'equal)
"Hash table of record relationships.
Keys are the related records' UUIDs, values are the relation
fields themselves.")
;;; Internal variables
(eval-and-compile
(defvar ebdb-debug t
"Enable debugging if non-nil during compile time.
You really should not disable debugging. But it will speed things up."))
(defvar ebdb-silent-internal nil
"Bind this to t to quiet things down - do not set it.
See also `ebdb-silent'.")
(defvar ebdb-dwim-completion-cache nil
"A list of strings as returned by `ebdb-dwim-mail'.
As mail field instances are created, a \"dwim\"-style string is
added here, for use in `completion-at-point' in mail buffers.")
(defvar ebdb-read-string-override nil
"An overriding prompt for `ebdb-read-string'.
This is bound dynamically around code that will end up calling
`ebdb-read-string'. It can be a plain string, in which case the
value will replace the existing prompt. It can also be a cons
of (STRING . POSITION), where POSITION can be one of the symbols
`append' or `prepend', in which case STRING will be concatenated
with the existing prompt as appropriate.")
;; Custom groups
(defgroup ebdb-eieio nil
"Options for an EIEIO version of EBDB."
:group 'ebdb)
(defcustom ebdb-sources (locate-user-emacs-file "ebdb")
"User option specifying EBDB database sources.
It can be a single element, or a list of elements. If an element
is a string, it is treated as a filename, and used to create an
instance of `ebdb-db-file'.
Elements can also be instances of subclasses of `ebdb-db'.
Currently, the only subclass is `ebdb-db-file', though you can
create your own. When EBDB is loaded, the `ebdb-db-load' method
will be called on each of class instances."
:group 'ebdb-eieio
;; Apparently we can't specify EBDB objects here.
:type '(choice (file :tag "File")
; (ebdb-db :tag "EBDB database instance")
(repeat (file :tag "File")
;; (choice (file :tag "File")
;; (ebdb-db :tag "EBDB database instance"))
)))
(defcustom ebdb-auto-merge-records nil
"If non-nil, automatically merge multiple records with the same UUID.
If you are using multiple databases, and intend to keep some
records in more than one database at once, you can set this to t
to have EBDB treat records with identical UUIDs as \"the same\"
record, and merge them automatically when the databases are
loaded. If it is nil, you'll be prompted to do an interactive
merge.
Merging is currently \"dumb\", ie the record with the older
timestamp is essentially deleted and replaced by the newer.
Future merging strategies may be smarter."
:group 'ebdb-eieio
:type 'boolean)
(defcustom ebdb-save-on-exit nil
"If non-nil, automatically save EBDB when exiting Emacs.
The user is always prompted to save the EBDB as part of the Emacs
shutdown process anyway, reducing the usefulness of this option.
If you're using EBDB without opening `ebdb-mode' buffers, you
might consider setting it to t."
:group 'ebdb-eieio
:type 'boolean)
(defcustom ebdb-default-record-class 'ebdb-record-person
"The default class to use for new records."
:group 'ebdb-eieio
:type '(restricted-sexp
:match-alternatives ((lambda (cls)
(and cls
(child-of-class-p
cls 'ebdb-record))))))
(defcustom ebdb-default-name-class 'ebdb-field-name-complex
"The default name class to use for person records.
Organization names are currently hard-coded to use
`ebdb-field-name-simple'."
:group 'ebdb-eieio
:type '(restricted-sexp
:match-alternatives ((lambda (cls)
(and cls
(child-of-class-p
cls 'ebdb-field-name))))))
(defcustom ebdb-default-mail-class 'ebdb-field-mail
"The default class to use for mail fields."
:group 'ebdb-eieio
:type '(restricted-sexp
:match-alternatives ((lambda (cls)
(and cls
(child-of-class-p
cls 'ebdb-field-mail))))))
(defcustom ebdb-default-phone-class 'ebdb-field-phone
"The default class to use for phone fields."
:group 'ebdb-eieio
:type '(restricted-sexp
:match-alternatives ((lambda (cls)
(and cls
(child-of-class-p
cls 'ebdb-field-phone))))))
(defcustom ebdb-default-address-class 'ebdb-field-address
"The default class to use for address fields."
:group 'ebdb-eieio
:type '(restricted-sexp
:match-alternatives ((lambda (cls)
(and cls
(child-of-class-p
cls 'ebdb-field-address))))))
(defcustom ebdb-default-notes-class 'ebdb-field-notes
"The default class to use for notes fields."
:group 'ebdb-eieio
:type '(restricted-sexp
:match-alternatives ((lambda (cls)
(and cls
(child-of-class-p
cls 'ebdb-field-notes))))))
(defcustom ebdb-try-speedups nil
"When non-nil, try to speed up loading by disabling checks.
This will set `eieio-skip-typecheck' when loading databases. The
type checks are done for a reason, it's possible this might lead
to errors or database corruption."
:group 'ebdb-eieio
:type 'boolean)
;; Do not use this to prevent writing of object-names via
;; `eieio-print-object-name', older Emacs will choke if it's not
;; present.
(defcustom ebdb-vacuum-databases t
"When non-nil, minimize the size of database files.
This option only has an effect in Emacs>27. At present it
prevents indentation from being written to the persistence files;
in the future more shrinkage may be possible."
:group 'ebdb-eieio
:type 'boolean)
(defcustom ebdb-print-object-name t
"When non-nil, print object names in the database files.
This is an EBDB-specific version of the option
`eieio-print-object-name', which only exists in Emacs 27 or
higher. It will have no effect in earlier versions of Emacs, but
do note that Emacs 26 or lower REQUIRES that the name be present,
and will raise an error if it is not. If there's a chance that a
database might be written by a newer Emacs, and read by an older,
do not set this to nil."
:group 'ebdb-eieio
:type 'boolean)
(defgroup ebdb nil
"EBDB customizations"
:group 'news
:group 'mail)
(defgroup ebdb-record-edit nil
"Variables that affect the editing of EBDB records."
:group 'ebdb)
(defgroup ebdb-sendmail nil
"Variables that affect sending mail."
:group 'ebdb)
(defgroup ebdb-snarf nil
"Customizations for EBDB snarf."
:group 'ebdb)
(put 'ebdb-snarf-snarf 'custom-loads '(ebdb-snarf))
(defgroup ebdb-search nil
"Customizations for EBDB searching."
:group 'ebdb)
(defgroup ebdb-utilities nil
"Customizations for EBDB utilities."
:group 'ebdb)
(defgroup ebdb-utilities-anniv nil
"Customizations for EBDB anniversaries."
:group 'ebdb)
(defgroup ebdb-utilities-dialing nil
"EBDB customizations for phone number dialing."
:group 'ebdb-utilities)
(defgroup ebdb-utilities-ispell nil
"Customizations for EBDB ispell interface"
:group 'ebdb-utilities)
(put 'ebdb-utilities-ispell 'custom-loads '(ebdb-ispell))
(defgroup ebdb-utilities-pgp nil
"Customizations for EBDB pgp"
:group 'ebdb-utilities)
(put 'ebdb-utilities-pgp 'custom-loads '(ebdb-pgp))
;;; Customizable variables
(defcustom ebdb-image nil
"The default method for displaying record images.
If a record is given a `ebdb-field-image' field, the value of
that field specifies how or where to find the image for the
record. This option provides a default for that value.
If the field value is `name' or `fl-name', the first and last
name of the record are used as file name. If it is `lf-name',
the last and first name of the record are used as file name.
If it is a string, that string is assumed to be a filename and
the file is searched in the directories in `ebdb-image-path'.
File name suffixes are appended according to
`ebdb-image-suffixes'. See `locate-file'.
If it is nil, the method `ebdb-field-image-function' will be
called with two arguments: the image field and the record. The
function should return either a filename, or actual image data."
:group 'ebdb-record-edit
:type '(choice (const :tag "Use built-in function" nil)
(string :tag "File name")
(const name)
(const fl-name)
(const lf-name)))
(defcustom ebdb-uuid-function "uuidgen"
"Function used for creating a UUID for records.
If a string, assume a system executable. If a symbol, assume an
elisp function for creating UUIDs. For instance, `org-id-uuid'
is a good candidate."
:group 'ebdb
:type '(choice (string :tag "System executable name")
(function :tag "Function creating UUIDs")))
(defcustom ebdb-record-self nil
"The UUID of the record representing the user.
See the docstring of `ebdb-user-mail-address-re' for possible uses."
:group 'ebdb
:type 'string)
(defcustom ebdb-country-list nil
"A list of country names known to EBDB.
This is a list of simple strings, which do not change EBDB's
behavior in any way. You can also require the \"ebdb-i18n\"
library for more internationally-aware functionality, in which
case this variable will be ignored."
:group 'ebdb
:type '(repeat string))
(defcustom ebdb-default-address-format-function #'ebdb-format-address-default
"Default function used to format an address.
This function produces a string that looks more or less like a US
address. Either write a custom function to format all addresses,
or load `ebdb-i18n' to format addresses based on country-specific
rules."
:group 'ebdb
:type 'function)
(defcustom ebdb-auto-revert nil
"If t revert unchanged database without querying.
If t and a database file has changed on disk, while the database
has not been modified inside Emacs, revert the database
automatically. If nil or the database has been changed inside
Emacs, always query before reverting."
:group 'ebdb
:type
'(choice (const :tag "Revert unchanged database without querying"
t)
(const :tag "Ask before reverting database" nil)))
(defcustom ebdb-use-diary t
"If non-nil add anniversary field values to the diary."
:group 'ebdb-utilities-anniv
:type 'boolean)
(make-obsolete-variable
'ebdb-use-diary
"Add %%(ebdb-diary-anniversaries) to your diary or to Org" "0.8")
(defcustom ebdb-anniversary-md-format "%B %d"
"Format string used for displaying month-day anniversary dates.
See the docstring of `format-time-string' for the meaning of
various formatting escapes, but keep in mind that only month and
day values are available."
:group 'ebdb-utilities-anniv
:type 'string)
(defcustom ebdb-anniversary-ymd-format "%B %d, %Y"
"Format string used for displaying year-month-day anniversary dates.
See the docstring of `format-time-string' for the meaning of
various formatting escapes, but keep in mind that only year,
month, and day values are available."
:group 'ebdb-utilities-anniv
:type 'string)
(defvar ebdb-diary-entries (make-hash-table :test #'equal)
"Hash table holding anniversary entries for the diary.
Keys are dates in the format (MONTH DAY YEAR), values are lists
of anniversary strings. Instances of `ebdb-field-anniversary'
fields can push descriptive strings into the hash entries for
their dates. Also see `ebdb-diary-anniversaries'.")
(defcustom ebdb-before-load-hook nil
"Hook run before loading databases."
:group 'ebdb
:type 'hook)
(defcustom ebdb-after-load-hook nil
"Hook run after loading databases."
:group 'ebdb
:type 'hook)
(defcustom ebdb-before-save-hook nil
"Hook run before saving all databases."
:type 'hook)
(defcustom ebdb-after-save-hook nil
"Hook run after saving all databases."
:type 'hook)
(defvar ebdb-create-hook nil
"*Hook run each time a new EBDB record is created.
Run with one argument, the new record. This is called before the record is
added to the database, followed by a call of `ebdb-change-hook'.
If a record has been created by analyzing a mail message, hook functions
can use the variable `ebdb-update-records-address' to determine the header
and class of the mail address according to `ebdb-message-headers'.")
(defvar ebdb-change-hook nil
"*Hook run each time a EBDB record is changed.
Run with one argument, the record. This is called before the database
is modified. If a new ebdb record is created, `ebdb-create-hook' is called
first, followed by a call of this hook.")
(defcustom ebdb-time-format "%Y-%m-%d %T %z"
"The EBDB time stamp format.
Used for human-readable display of timestamp values."
:group 'ebdb
:type 'string)
(defcustom ebdb-after-change-hook nil
"Hook run each time a EBDB record is changed.
Run with one argument, the record. This is called after the database
is modified. So if you want to modify a record when it is created or changed,
use instead `ebdb-create-hook' and / or `ebdb-change-hook'."
:group 'ebdb
:type 'hook)
;; These two hooks could actually be done away with, and replaced by
;; method overloads on `ebdb-db-load'. But users will probably be
;; more familiar with hooks than with method overloading.
(defcustom ebdb-before-load-db-hook nil
"Hook run before each database is loaded.
Run with one argument, the database being loaded."
:group 'ebdb
:type 'hook)
(defcustom ebdb-after-load-db-hook nil
"Hook run after each database is loaded.
Run with one argument, the database being loaded."
:group 'ebdb
:type 'hook)
(defcustom ebdb-before-save-db-hook nil
"Hook run before each database is saved.
Run with one argument, the database being saved."
:group 'ebdb
:type 'hook)
(defcustom ebdb-after-save-db-hook nil
"Hook run after each database is saved.
Run with one argument, the database being saved."
:group 'ebdb
:type 'hook)
(defcustom ebdb-initialize-hook nil
"Normal hook run after the EBDB initialization function `ebdb-initialize'."
:group 'ebdb
:type 'hook)
(defcustom ebdb-silent nil
"If t, EBDB suppresses all its informational messages and queries.
Be very very certain you want to set this to t, because it will suppress
queries to alter record names, assign names to addresses, etc.
Lisp Hackers: See also `ebdb-silent-internal'."
:group 'ebdb
:type '(choice (const :tag "Run silently" t)
(const :tag "Disable silent running" nil)))
(defcustom ebdb-search-transform-functions nil
"Functions used to transform strings during searching.
Each time the user enters a search search string during
interactive search, that string will be passed through each of
the functions in this list, which have a chance to modify the
string somehow before it is actually matched against field
values.
Each function should accept a single argument, a string, and
return the transformed string. If the criteria for any given
search is not a string, it will not be passed through these
functions."
:group 'ebdb-search
:type '(repeat :tag "String transformation function" function))
(defcustom ebdb-case-fold-search (default-value 'case-fold-search)
"Value of `case-fold-search' used when searching EBDB records."
:group 'ebdb-search
:type 'boolean)
(defcustom ebdb-char-fold-search nil
"If t, record searches will use character folding.
Character folding means that, for instance, searches for \"i\"
will match \"ì\", and so on. This may slow searching down."
:group 'ebdb-search
:type 'boolean)
(defcustom ebdb-hash-extra-predicates nil
"Extra predicates when looking up entries in the EBDB hashtable.
Predicates are used to filter results from the hashtable,
ensuring that string lookups only return the results they're
meant to.
This option should be a list of conses, where the car is a
symbol, and the cdr is a lambda form which accepts the string key
and a record, and returns t if the key is acceptable for
returning that record."
:group 'ebdb-search
:package-version "0.2"
:type '(repeat (cons symbol function)))
(defcustom ebdb-signal-program (executable-find "signal-cli")
"The name of the signal-cli program, if installed.
This program must be present in order to send text messages
through the Signal service."
:group 'ebdb-utilities-dialing
:type 'string)
(defcustom ebdb-info-file nil
"Location of the ebdb info file, if it's not in the standard place."
:group 'ebdb
:type '(choice (const :tag "Standard location" nil)
(file :tag "Nonstandard location")))
(defcustom ebdb-canonical-hosts
;; Example
(regexp-opt '("cs.cmu.edu" "ri.cmu.edu"))
"Regexp matching the canonical part of the domain part of a mail address.
If the domain part of a mail address matches this regexp, the domain
is replaced by the substring that actually matched this address.
Used by `ebdb-canonicalize-mail-1'. See also `ebdb-ignore-redundant-mails'."
:group 'ebdb-utilities
:type '(regexp :tag "Regexp matching sites"))
(defcustom ebdb-canonicalize-mail-function nil
"If non-nil, it should be a function of one arg: a mail address string.
When EBDB is parsing mail addresses, the corresponding mail
addresses are passed to this function first. It acts as a kind
of \"filter\" to transform the mail addresses before they are
compared against or added to the database. See
`ebdb-canonicalize-mail-1' for a more complete example. If this
function returns nil, EBDB assumes that there is no mail address.
See also `ebdb-ignore-redundant-mails'."
:group 'ebdb-utilities
:type 'function)
(defcustom ebdb-message-clean-name-function 'ebdb-message-clean-name-default
"Function to clean up the name in the header of a message.
It takes one argument, the name as extracted by
`mail-extract-address-components'."
:group 'ebdb-utilities
:type 'function)
(defsubst ebdb-record-self ()
"Return the \"self\" record."
(ebdb-gethash ebdb-record-self 'uuid))
;;; Record editing
(defcustom ebdb-default-separator '("[,;]" ", ")
"The default field separator. It is a list (SPLIT-RE JOIN).
This is used for fields which do not have an entry in `ebdb-separator-alist'."
:group 'ebdb-record-edit
:type '(list regexp string))
(defcustom ebdb-separator-alist
'((record "\n\n" "\n\n") ; used by `ebdb-copy-fields-as-kill'
(name-first-last "[ ,;]" " ")
(name-last-first "[ ,;]" ", ")
(name-field ":\n" ":\n") ; used by `ebdb-copy-fields-as-kill'
(phone "[,;]" ", ")
(address ";\n" ";\n")
(organization "[,;]" ", ")
(aka "[,;]" ", ")
(mail "[,;]" ", ")
(ebdb-field-tags ":" ":")
(mail-alias "[,;]" ", ")
(vm-folder "[,;]" ", ")
(birthday "\n" "\n")
(wedding "\n" "\n")
(anniversary "\n" "\n")
(notes "\n" "\n"))
"Alist of field separators.
Each element is of the form (FIELD SPLIT-RE JOIN).
For fields lacking an entry here `ebdb-default-separator' is used instead."
:group 'ebdb-record-edit
:type '(repeat (list symbol regexp string)))
(defcustom ebdb-completion-ignore-case t
"EBDB-specific value of `completion-ignore-case'.
This has an effect when entering field data with completion, for
instance anniversary months or address countries."
:group 'ebdb-record-edit
:type 'boolean)
(defcustom ebdb-image-path nil
"List of directories to search for `ebdb-image'."
:group 'ebdb-record-edit
:type '(repeat (directory)))
(defcustom ebdb-image-suffixes '(".png" ".jpg" ".gif" ".xpm")
"List of file name suffixes searched for `ebdb-image'."
:group 'ebdb-record-edit
:type '(repeat (string :tag "File suffix")))
(defcustom ebdb-read-name-articulate nil
"Specify how to read record names.
If nil, read full names as single strings, and parse them
accordingly. If t, the user will be prompted separately for each
field of the name.
If this option is nil, and the user enters a single string, the
resulting name field will be an instance of
`ebdb-field-name-simple'. Even if this option is t, the user can
still trigger the creation of a simple name field by entering a
single string for the surname, and nothing else."
:group 'ebdb-record-edit
:type 'boolean)
(defcustom ebdb-lastname-prefixes
'("von" "van" "de" "di")
"List of lastname prefixes recognized in name fields.
Used to enhance dividing name strings into firstname and lastname parts.
Case is ignored."
:group 'ebdb-record-edit
:type '(repeat string))
(defcustom ebdb-lastname-re
(concat "[- \t]*\\(\\(?:\\<"
(regexp-opt ebdb-lastname-prefixes)
;; Last names can contain hyphens and apostrophes.
"\\>[- \t]+\\)?\\w[[:word:]'-]+\\)\\>")
"Regexp matching the last name of a full name.
Its first parenthetical subexpression becomes the last name."
:group 'ebdb-record-edit
:type 'regexp)
(defcustom ebdb-lastname-suffixes
'("Jr" "Sr" "II" "III")
"List of lastname suffixes recognized in name fields.
Used to dividing name strings into firstname and lastname parts.
All suffixes are complemented by optional `.'. Case is ignored."
:group 'ebdb-record-edit
:type '(repeat string))
(defcustom ebdb-lastname-suffix-re
(concat "[-,. \t/\\]+\\("
(regexp-opt ebdb-lastname-suffixes)
;; suffices are complemented by optional `.'.
"\\.?\\)\\W*\\'")
"Regexp matching the suffix of a last name.
Its first parenthetical subexpression becomes the suffix."
:group 'ebdb-record-edit
:type 'regexp)
(defcustom ebdb-allow-duplicates nil
"When non-nil EBDB allows records with duplicate names and email addresses.
In rare cases, this may lead to confusion with EBDB's MUA interface."
:group 'ebdb-record-edit
:type 'boolean)
(defcustom ebdb-address-label-list '("home" "work" "other")
"List of labels for Address field."
:group 'ebdb-record-edit
:type '(repeat string))
(defcustom ebdb-phone-label-list '("home" "work" "cell" "fax" "other")
"List of labels for Phone field."
:group 'ebdb-record-edit
:type '(repeat string))
(defcustom ebdb-default-country "Emacs";; what do you mean, it's not a country?
"Default country to use for addresses."
:group 'ebdb-record-edit
:type '(choice (const :tag "None" nil)
(string :tag "Default Country")))
(defcustom ebdb-default-phone-country nil
"Default country to use for phone numbers.
Should be an integer representing the country code for phone
numbers.
If EBDB can't determine the country when parsing a phone number,
it will assume this default, if set. When displaying phone
numbers, the country code will be omitted if it matches this
option."
:group 'ebdb-record-edit
:type '(choice (const :tag "None" nil)
(integer :tag "Default Country")))
(defcustom ebdb-default-user-field 'ebdb-field-notes
"Default field when editing EBDB records."
:group 'ebdb-record-edit
:type '(symbol :tag "Field"))
(defcustom ebdb-url-valid-schemes '("http:" "https:" "irc:")
"Strings matching acceptable URL schemes.
Strings should not be regular expressions. They should include
the colon character."
:group 'ebdb-record-edit
:type '(repeat string))
(defcustom ebdb-mail-avoid-redundancy nil
"How to handle the name part of `ebdb-dwim-mail'.
If nil, always return both name and mail. If value is mail-only
never use full name. Other non-nil values mean do not use full
name in mail address when same as mail."
:group 'ebdb-sendmail
:type '(choice (const :tag "Allow redundancy" nil)
(const :tag "Never use full name" mail-only)
(const :tag "Avoid redundancy" t)))
(defcustom ebdb-complete-mail t
"If non-nil composition MUAs will complete EBDB contacts.
Completion takes place within mail headers that specify one or
more message recipients. A value of `capf' will add an EBDB
collection to `completion-at-point-functions'. Any other non-nil
value will override \"TAB\" to call `ebdb-complete-mail'."
:group 'ebdb-sendmail
:type '(choice (const :tag "Use `ebdb-complete-mail'" t)
(const :tag "Do not complete mail addresses" nil)
(const :tag "Use completion at point" capf)))
(defcustom ebdb-completion-list t
"Controls the behaviour of function `ebdb-complete-mail'.
If a list of symbols, it specifies which fields to complete. Symbols include
name (= record's display name)
alt-names (= any other names the record has)
organization
mail (= all email addresses of each record)
primary (= first email address of each record)
If t, completion is done for all of the above.
If nil, no completion is offered."
;; These symbols match the fields for which EBDB provides entries in
;; `ebdb-hash-table'.
:group 'ebdb-sendmail
:type '(choice (const :tag "No Completion" nil)
(const :tag "Complete across all fields" t)
(repeat :tag "Field"
(choice (const name)
(const alt-names)
(const organization)
(const primary)
(const mail)))))
(defcustom ebdb-complete-mail-allow-cycling 5
"If non-nil, cycle mail addresses when completing mails.
If `ebdb-complete-mail' is set to `capf', this option can be set
to an integer number, specifying that completion should take
place when there are that many completion candidates or fewer.
Otherwise, cycling will take place among all a single contact's
email addresses."
:group 'ebdb-sendmail
:type '(choice (const :tag "Never cycle" nil)
(const :tag "Always cycle" t)
(number :tag "Cycle for this many candidates or fewer")))
(defcustom ebdb-complete-mail-hook nil
"List of functions called after a successful completion."
:group 'ebdb-sendmail
:type 'hook)
(defcustom ebdb-mail-abbrev-expand-hook nil
;; Replacement for function `mail-abbrev-expand-hook'.
"Function (not hook) run each time an alias is expanded.
The function is called with two args: the alias and the list of
corresponding mail addresses."
:group 'ebdb-sendmail
:type 'function)
(defcustom ebdb-completion-display-record t
"If non-nil, `ebdb-complete-mail' will display records after completion."
:group 'ebdb-sendmail
:type '(choice (const :tag "Update the EBDB buffer" t)
(const :tag "Do not update the EBDB buffer" nil)))
(defvar ebdb-update-unchanged-records nil
"If non-nil update unchanged records in the database.
Normally calls of `ebdb-change-hook' and updating of a record are suppressed,
if an editing command did not really change the record. Bind this to t
if you want to call `ebdb-change-hook' and update the record unconditionally.")
(defvar ebdb-street-list nil
"List of streets known to EBDB.")
(defvar ebdb-locality-list nil
"List of localities (towns or cities) known to EBDB.")
(defvar ebdb-region-list nil
"List of regions (states or provinces) known to EBDB.")
(defvar ebdb-postcode-list nil
"List of post codes known to EBDB.")
;;; Define some of our own errors. A few of these should never be
;;; shown to the user, they're for internal flow control.
;; Error parent
(define-error 'ebdb-error "EBDB error")
(define-error 'ebdb-duplicate-uuid "Duplicate EBDB UUID" 'ebdb-error)
(define-error 'ebdb-related-unfound "Could not find related record" 'ebdb-error)
(define-error 'ebdb-unsynced-db "EBDB DB unsynced" 'ebdb-error)
(define-error 'ebdb-disabled-db "EBDB DB disabled" 'ebdb-error)
(define-error 'ebdb-readonly-db "EBDB DB read-only" 'ebdb-error)
(define-error 'ebdb-unacceptable-field "EBDB record cannot accept field" 'ebdb-error)
(define-error 'ebdb-empty "Empty value" 'ebdb-error)
(define-error 'ebdb-unparseable "Unparseable value" 'ebdb-error)
;;; Utility functions and macros
;;;###autoload
(defsubst ebdb-records (&optional record-class child-p)
"Return a list of all EBDB records; load databases if necessary.
This function also notices if databases are out of sync.
If RECORD-CLASS is given, only return records of this class or,
if CHILD-P is non-nil, one of its subclasses."
(unless ebdb-db-list
(ebdb-load))
(if record-class
(seq-filter
(lambda (r)
(if child-p
(object-of-class-p r record-class)
(same-class-p r record-class)))
ebdb-record-tracker)
ebdb-record-tracker))
(defmacro ebdb-error-retry (&rest body)
"Repeatedly execute BODY ignoring errors till no error occurs."
`(catch '--ebdb-error-retry--
(while t
(condition-case --c--
(throw '--ebdb-error-retry-- (progn ,@body))
(ebdb-unparseable
(ding)
(message "Error: %s" (nth 1 --c--))
(sit-for 2))))))
(defmacro ebdb-with-exit (&rest body)
"Execute BODY, returning nil on quit or an empty value."
`(condition-case nil
,@body
((quit ebdb-empty)
nil)))
(defmacro ebdb-loop-with-exit (&rest body)
"Repeat BODY, accumulating the results in a list.
\\<minibuffer-mode-map>Return when the user either hits
\\[keyboard-quit], or enters an empty field value."
`(let (acc)
(catch '--ebdb-loop-exit--
(condition-case nil
(while t
(push ,@body acc))
((quit ebdb-empty)
(throw '--ebdb-loop-exit-- (nreverse acc)))))))
(defmacro ebdb-debug (&rest body)
"Execute BODY just like `progn' with debugging capability.
Debugging is enabled if variable `ebdb-debug' is non-nil during compile.
You really should not disable debugging. But it will speed things up."
(declare (indent 0))
(if ebdb-debug ; compile-time switch
`(let ((debug-on-error t))
,@body)))
(defmacro ebdb-pushnew (element place)
`(cl-pushnew ,element ,place :test #'equal))
(defmacro ebdb-delete-from-list (element list-var)
"Remove ELEMENT from LIST-VAR, if present.
Test for presence is done with `equal'."
(macroexp-let2 nil element element
`(when ,element
,(gv-letplace (getter setter) list-var
(funcall setter `(delete ,element ,getter))))))
;;; Struct and object definitions.
;; The calls to `cl-defstruct' and `defclass' are all up here
;; together, to help with order of definition.
(cl-defstruct ebdb-record-cache
"Structure holding cached values for a record."
(name-string "" :type string :documentation
"Canonical name string")
(alt-names nil :type list :documentation
"List of alternate names")
(organizations nil :type list :documentation
"List of related organization name strings")
;; FIXME: Nothing seems to use this mail-aka information. Delete
;; it, and/or consider a general re-working of how EBDB handles
;; name-mail pairs.
(mail-aka nil :type list :documentation
"List of akas associated with mail addresses")
(mail-canon nil :type list :documentation
"List of all record's mail addresses")
;; FIXME: Erm, we don't sort EBDB records at all! And setting a
;; single string as a sortkey is way too limiting: instead offer
;; multiple sorting strategies.
(sortkey nil :type string :documentation
"String used for sorting record against other records")
(databases nil :type list :documentation
"List of database instances this record belongs to"))
(defclass ebdb-field ()
((actions
:type (list-of cons)
:allocation :class
:initform nil
:documentation
"A list of actions which this field can perform. Each list
element is a cons of string name and function name.")
(comment
:type (or null string)
:custom (choice (const :tag "No comment" nil)
(string :tag "Comment"))
:initarg :comment
:initform nil
:documentation
"Arbitrary comment on this field value"))
:abstract t :documentation "Abstract class for EBDB fields.
Subclass this to produce real field types.")
(defclass ebdb-record (eieio-instance-tracker)
((uuid
:initarg :uuid
:type (or null ebdb-field-uuid)
:initform nil)
(tracking-symbol
:initform 'ebdb-record-tracker)
(creation-date
:initarg :creation-date
:type (or null ebdb-field-creation-date)
:initform nil)
(timestamp
:initarg :timestamp
:type (or null ebdb-field-timestamp)
:initform nil)
(fields
:initarg :fields
:type (list-of ebdb-field-user)
:initform nil
:documentation "This slot contains all record fields except
those built in to record subclasses.")
(image
:initarg :image
:type (or null ebdb-field-image)
:initform nil)
(notes
:initarg :notes
:type (or null ebdb-field-notes)
:initform nil
:documentation "User notes for this contact.")
(dirty