[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ebdb 3210ad7 338/350: Compiler-inspired fixes version 4
|
From: |
Eric Abrahamsen |
|
Subject: |
[elpa] externals/ebdb 3210ad7 338/350: Compiler-inspired fixes version 443992 |
|
Date: |
Mon, 14 Aug 2017 11:47:06 -0400 (EDT) |
branch: externals/ebdb
commit 3210ad793cd8a418328e7093dc055c1ab1416bf9
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>
Compiler-inspired fixes version 443992
Getting as close to zero warnings as possible before going into ELPA
Mostly moving code around so it's defined in the right order, more
defvars, declare-functions and autoloads, underscores on unused
parameters, some deletion of unused/unreachable code. And I snuck in
some edits to phone dialing (sorry!).
---
ebdb-com.el | 128 ++---
ebdb-format.el | 4 +-
ebdb-gnorb.el | 6 +-
ebdb-gnus.el | 3 +-
ebdb-i18n.el | 867 +++++++++++++++----------------
ebdb-message.el | 2 +
ebdb-migrate.el | 6 +-
ebdb-mua.el | 2 +
ebdb-org.el | 3 +-
ebdb-vcard.el | 2 +
ebdb.el | 1544 ++++++++++++++++++++++++++-----------------------------
helm-ebdb.el | 2 +-
12 files changed, 1240 insertions(+), 1329 deletions(-)
diff --git a/ebdb-com.el b/ebdb-com.el
index 527605d..7023c1d 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -91,6 +91,13 @@ Used by `ebdb-mouse-menu'."
:group 'ebdb
:group 'faces)
+(defcustom ebdb-name-face-alist '((ebdb-record-person . ebdb-person-name)
+ (ebdb-record-organization .
ebdb-organization-name))
+ "Alist matching record class types to the face that should be
+ used to font-lock their names in the *EBDB* buffer."
+ :group 'ebdb-faces
+ :type '(repeat (cons (ebdb-record :tag "Record type") (face :tag "Face"))))
+
(defface ebdb-person-name
'((t (:inherit font-lock-function-name-face)))
"Face used for EBDB person names."
@@ -101,13 +108,6 @@ Used by `ebdb-mouse-menu'."
"Face used for EBDB organization names."
:group 'ebdb-faces)
-(defcustom ebdb-name-face-alist '((ebdb-record-person . ebdb-person-name)
- (ebdb-record-organization .
ebdb-organization-name))
- "Alist matching record class types to the face that should be
- used to font-lock their names in the *EBDB* buffer."
- :group 'ebdb-faces
- :type '(repeat (cons (ebdb-record :tag "Record type") (face :tag "Face"))))
-
(defface ebdb-marked
'((t (:background "LightBlue")))
"Face used for currently-marked records."
@@ -193,9 +193,6 @@ If FULL is non-nil, assume that RECORDS include display
information."
;; Note about EBDB prefix commands: `ebdb-search-invert' is a fake
;; prefix commands. They need not precede the main commands.
-(defvar ebdb-search-invert nil
- "Bind this variable to t in order to invert the result of `ebdb-search'.")
-
(defun ebdb-search-invert-p ()
"Return variable `ebdb-search-invert' and set it to nil.
To set it again, use command `ebdb-search-invert'."
@@ -2008,10 +2005,6 @@ the record to be displayed or nil otherwise."
;;; Send-Mail interface
-(defun ebdb-compose-mail (&rest args)
- "Start composing a mail message to send."
- (apply 'compose-mail args))
-
;;;###autoload
(defun ebdb-mail (records &optional subject arg)
"Compose a mail message to RECORDS (optional: using SUBJECT).
@@ -2528,64 +2521,51 @@ actions."
(funcall action record field)
(message "No action for field")))
-
-;;; Dialing numbers from EBDB
-
-(defun ebdb-dial-number (phone-string)
- "Dial the number specified by PHONE-STRING.
-This uses the tel URI syntax passed to `browse-url' to make the call.
-If `ebdb-dial-function' is non-nil then that is called to make the phone call."
- (interactive "sDial number: ")
- (if ebdb-dial-function
- (funcall ebdb-dial-function phone-string)
- (browse-url (concat "tel:" phone-string))))
-
-;;;###autoload
-(defun ebdb-dial (phone force-area-code)
- "Dial the number at point.
-If the point is at the beginning of a record, dial the first phone number.
-Use rules from `ebdb-dial-local-prefix-alist' unless prefix FORCE-AREA-CODE
-is non-nil. Do not dial the extension."
- (interactive (list (ebdb-current-field) current-prefix-arg))
- (if (eq phone 'ebdb-record-name)
- (setq phone (car (ebdb-record-phone (ebdb-current-record)))))
- (or (and (eieio-object-p phone)
- (object-of-class-p phone 'ebdb-field-phone))
- (error "Not on a phone field"))
-
- (let ((number (ebdb-string phone))
- shortnumber)
-
- ;; cut off the extension
- (if (string-match "x[0-9]+$" number)
- (setq number (substring number 0 (match-beginning 0))))
-
- (unless force-area-code
- (let ((alist ebdb-dial-local-prefix-alist) prefix)
- (while (setq prefix (pop alist))
- (if (string-match (concat "^" (eval (car prefix))) number)
- (setq shortnumber (concat (cdr prefix)
- (substring number (match-end 0)))
- alist nil)))))
-
- (if shortnumber
- (setq number shortnumber)
-
- ;; This is terrifically Americanized...
- ;; Leading 0 => local number (?)
- (if (and ebdb-dial-local-prefix
- (string-match "^0" number))
- (setq number (concat ebdb-dial-local-prefix number)))
-
- ;; Leading + => long distance/international number
- (if (and ebdb-dial-long-distance-prefix
- (string-match "^\+" number))
- (setq number (concat ebdb-dial-long-distance-prefix " "
- (substring number 1)))))
-
- (unless ebdb-silent
- (message "Dialing %s" number))
- (ebdb-dial-number number)))
+(defun ebdb-dial ()
+ "Dial the phone number under point, or the first number of record under
point."
+ (interactive)
+ (let* ((rec (ebdb-current-record))
+ (phone (or (when (object-of-class-p (ebdb-current-field)
+ 'ebdb-field-phone)
+ (ebdb-current-field))
+ (ebdb-record-phone rec)
+ (error "No phone to dial"))))
+ (ebdb-field-phone-dial rec phone)))
+
+;; This function is in addition to the phone field method
+;; `ebdb-field-phone-signal-text', because that will only allow you to
+;; text the single number, while this will allow texting to multiple
+;; recipients.
+(defun ebdb-signal-text (sender records message attachments)
+ "Compose and send a text message using the Signal protocol.
+
+SENDER should be a phone number (with leading \"+\") to send
+from. If `ebdb-record-self' is set, this record will be used as
+the sender, while RECORDS will be used as the list of recipients.
+In both cases, `ebdb-signal-get-number' will be used to find a
+usable number from the record.
+
+MESSAGE is the string to send as the body of the text message.
+ATTACHMENTS is a list of filenames to send as attachments on the
+message."
+ (interactive
+ (list (or (and ebdb-record-self
+ (ebdb-signal-get-number
+ (ebdb-gethash ebdb-record-self 'uuid)
+ t))
+ (ebdb-read-string
+ "Number to send from (or set `ebdb-record-self'): "))
+ (ebdb-do-records)
+ (ebdb-read-string "Message contents: ")
+ (ebdb-loop-with-exit
+ (expand-file-name
+ (read-file-name "Attach file (C-g when done): "
+ nil nil nil)))))
+ (let ((recipients
+ (delq nil (mapcar #'ebdb-signal-get-number records))))
+ (if ebdb-signal-program
+ (ebdb--signal-text sender message recipients attachments)
+ (message "Please set `ebdb-signal-program'"))))
;;; Adding urls
@@ -2600,8 +2580,8 @@ is non-nil. Do not dial the extension."
(ebdb-read-string "URL label: "
nil ebdb-url-label-list))))
(let ((url-field (make-instance 'ebdb-field-url :url url :object-name
label)))
- (ebdb-record-insert-field record url-field 'fields)
- (ebdb-display-records (list record))))
+ (ebdb-record-insert-field record url-field 'fields)
+ (ebdb-display-records (list record))))
;;; Copy to kill ring
diff --git a/ebdb-format.el b/ebdb-format.el
index 0c13d09..cd8ccc5 100644
--- a/ebdb-format.el
+++ b/ebdb-format.el
@@ -27,6 +27,8 @@
;;; Code:
(require 'ebdb)
+(declare-function ebdb-do-records "ebdb-com")
+(declare-function ebdb-display-records "ebdb-com")
;; qp = quoted-printable, might not end up needing this.
(require 'qp)
@@ -276,7 +278,7 @@ which formats them appropriately."
(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter)
(record ebdb-record-person)
&optional field-list)
-
+
(with-slots (exclude include) fmt
(with-slots (aka organizations relations) record
(when (and aka
diff --git a/ebdb-gnorb.el b/ebdb-gnorb.el
index e3832af..eba3f16 100644
--- a/ebdb-gnorb.el
+++ b/ebdb-gnorb.el
@@ -106,7 +106,7 @@ message was received."
(actions :initform '(("Follow link" . gnorb-ebdb-follow-link))))
:human-readable "gnus messages")
-(defun gnorb-ebdb-follow-link (record field)
+(defun gnorb-ebdb-follow-link (_record _field)
(when-let ((link (or
(get-text-property (point) 'gnorb-link)
(get-text-property
@@ -133,10 +133,10 @@ message was received."
(sec (and delta (abs real-sec))))
(floor (/ sec 86400))))
-(cl-defmethod ebdb-fmt-field ((fmt ebdb-formatter-ebdb)
+(cl-defmethod ebdb-fmt-field ((_fmt ebdb-formatter-ebdb)
(field gnorb-ebdb-field-messages)
_style
- (record ebdb-record))
+ (_record ebdb-record))
(let* ((msgs (slot-value field 'messages))
(outstring
(if (= (length msgs) 0)
diff --git a/ebdb-gnus.el b/ebdb-gnus.el
index fea53c6..f4d3e56 100644
--- a/ebdb-gnus.el
+++ b/ebdb-gnus.el
@@ -25,7 +25,8 @@
(require 'ebdb-com)
(require 'ebdb-mua)
-(require 'gnus)
+(require 'gnus-sum)
+(require 'gnus-art)
(autoload 'message-make-domain "message")
diff --git a/ebdb-i18n.el b/ebdb-i18n.el
index 9293521..c9a4f01 100644
--- a/ebdb-i18n.el
+++ b/ebdb-i18n.el
@@ -21,11 +21,10 @@
;; This file contains extensions to EBDB, making it more
;; internationally aware. It works by hijacking many of the common
-;; methods for field manipulation, by attaching :extra methods to
-;; them, and dispatching to new methods that allow for specialization
-;; on country codes, area codes, character scripts, etc. The new
-;; methods are generally named the same as the old methods, plus a
-;; "-i18n" suffix.
+;; methods for field manipulation, attaching :extra methods to them,
+;; and dispatching to new methods that allow for specialization on
+;; country codes, area codes, character scripts, etc. The new method
+;; names are the same as the old names, plus a "-i18n" suffix.
;; The methods in this file are only responsible for doing the
;; hijacking, and calling the i18n versions of the original methods --
@@ -54,438 +53,270 @@
:type 'list
:group 'ebdb-i18n)
-(cl-defgeneric ebdb-read-i18n (class slots obj spec)
- "An internationalized version of `ebdb-read'.
-
-This works the same as `ebdb-read', plus an additional argument
-SPEC. What SPEC is depends on CLASS, but might be a phone
-country code, or a country symbol, or a script symbol.
-
-This method should return a plist of slots for object creation.")
-
-(cl-defgeneric ebdb-parse-i18n (class string spec &optional slots)
- "An internationalized version of `ebdb-parse'.
-
-This works the same as `ebdb-read', plus an additional argument
-SPEC. What SPEC is depends on CLASS, but might be a phone
-country code, or a country symbol, or a script symbol. SLOTS is
-a plist of existing slot values.
-
-This method should return a new instance of CLASS.")
-
-(cl-defgeneric ebdb-string-i18n (field spec)
- "An internationalized version of `ebdb-string'.")
-
-(cl-defgeneric ebdb-init-field-i18n (field record spec)
- "An internationalized version of `ebdb-init-field'.")
-
-(cl-defgeneric ebdb-delete-field-i18n (field record spec unload)
- "An internationalized version of `ebdb-delete-field'.")
-
-(cl-defmethod ebdb-parse-i18n :around (_class _string _spec &optional _slots)
- "Don't clobber match data when testing names."
- (save-match-data
- (cl-call-next-method)))
-
-;;;###autoload
-(defun ebdb-internationalize-addresses ()
- "Go through all the EBDB contacts and \"internationalize\"
- address fields.
-
-Essentially this just means swapping out the string country names
-for their symbol representations.")
-
-(cl-defmethod ebdb-read :extra "i18n" ((class (subclass ebdb-field-address))
- &optional slots obj)
- (let ((country
- (cdr (assoc (completing-read
- "Country: "
- ebdb-i18n-countries nil nil
- (when obj (car (rassoc (ebdb-address-country obj)
- ebdb-i18n-countries))))
- ebdb-i18n-countries))))
- (setq slots
- (condition-case nil
- (ebdb-read-i18n class
- (plist-put slots :country country) obj country)
- (cl-no-method
- (plist-put slots :country country))))
- (cl-call-next-method class slots obj)))
-
-(cl-defmethod ebdb-read :extra "i18n" ((class (subclass ebdb-field-phone))
- &optional slots obj)
- (let ((country
- (if obj
- (slot-value obj 'country-code)
- (cdr (assoc (completing-read
- "Country/Region: "
- ebdb-i18n-phone-codes nil nil)
- ebdb-i18n-phone-codes))))
- area-code)
- ;; Obviously this whole structure thing is just poorly
- ;; thought-out.
- (when (consp country)
- (cond ((numberp (car country))
- (setq area-code (second country)
- country (car country)))
- ((consp (car country))
- (setq country (assoc
- (string-to-number
- (completing-read
- "Choose: "
- (mapcar (lambda (x)
- (number-to-string (car x)))
- country)))
- country)
- area-code (second country))))
- (when (consp area-code)
- (setq area-code (string-to-number
- (completing-read
- "Area code: "
- (mapcar #'number-to-string area-code))))))
- (when area-code
- (setq slots (plist-put slots :area-code area-code)))
- (setq slots (plist-put slots :country-code country))
- (setq slots
- (condition-case nil
- (ebdb-read-i18n class slots obj country)
- (cl-no-method
- slots)))
- (cl-call-next-method class slots obj)))
-
-(cl-defmethod ebdb-string :extra "i18n" ((phone ebdb-field-phone))
- "Internationally-aware version of `ebdb-string' for phones."
- (let ((cc (slot-value phone 'country-code)))
- (or (and cc
- (condition-case nil
- (ebdb-string-i18n phone cc)
- (cl-no-method nil)))
- (cl-call-next-method))))
-
-(cl-defmethod ebdb-parse :extra "i18n" ((class (subclass ebdb-field-phone))
- (str string)
- &optional slots)
- (let ((cc (or (plist-get slots :country-code)
- (and (string-match "\\`(?\\+(?\\([0-9]\\{1,3\\}\\))?[ \t]+" str)
- (string-to-number (match-string 1 str))))))
- (or (and cc
- (condition-case nil
- (ebdb-parse-i18n
- class
- (replace-match "" nil nil str 0)
- cc (plist-put slots :country-code cc))
- (cl-no-method nil)))
- (cl-call-next-method))))
-
-;; We don't need to override the `ebdb-read' method for names. It
-;; only matters what script the name is in if the user has set
-;; `ebdb-read-name-articulate' to nil, in which case the name is
-;; passed to this `ebdb-parse' method.
-(cl-defmethod ebdb-parse :extra "i18n" ((class (subclass
ebdb-field-name-complex))
- (string string)
- &optional slots)
- ;; For now, only test the first character of whatever string the
- ;; user has entered.
- (let ((script (unless (string-empty-p string)
- (aref char-script-table (aref string 0)))))
- (or (and script
- (null (memq script ebdb-i18n-ignorable-scripts))
- (condition-case nil
- (ebdb-parse-i18n class string script slots)
- (cl-no-method
- nil)))
- (cl-call-next-method))))
-
-(cl-defmethod ebdb-string :extra "i18n" ((name ebdb-field-name-complex))
- (let* ((str (cl-call-next-method name))
- (script (aref char-script-table (aref str 0))))
- (unless (memq script ebdb-i18n-ignorable-scripts)
- (condition-case nil
- (setq str (ebdb-string-i18n name script))
- (cl-no-method nil)))
- str))
-
-(cl-defmethod ebdb-init-field :extra "i18n" ((name ebdb-field-name) &optional
record)
- "Do additional initialization work for international names."
- (let* ((res (cl-call-next-method name record))
- (str (ebdb-string name))
- (script (aref char-script-table (aref str 0))))
- (unless (memq script ebdb-i18n-ignorable-scripts)
- (condition-case nil
- (ebdb-init-field-i18n name record script)
- (cl-no-method nil)))
- res))
-
-(cl-defmethod ebdb-delete-field :extra "i18n" ((name ebdb-field-name)
&optional record unload)
- "Do additional deletion work for international names."
- (let* ((str (ebdb-string name))
- (script (aref char-script-table (aref str 0))))
- (unless (memq script ebdb-i18n-ignorable-scripts)
- (condition-case nil
- (ebdb-delete-field-i18n name record script unload)
- (cl-no-method nil))))
- (cl-call-next-method))
+;; defvars come first to pacify compiler.
+;; Taken from https://en.wikipedia.org/wiki/ISO_3166-1_alpha-3, on Feb
+;; 27, 2016
(defvar ebdb-i18n-countries
'(
-("Afghanistan" . afg)
-("Åland Islands" . ala)
-("Albania" . alb)
-("Algeria" . dza)
-("American Samoa" . asm)
-("Andorra" . and)
-("Angola" . ago)
-("Anguilla" . aia)
-("Antarctica" . ata)
-("Antigua and Barbuda" . atg)
-("Argentina" . arg)
-("Armenia" . arm)
-("Aruba" . abw)
-("Australia" . aus)
-("Austria" . aut)
-("Azerbaijan" . aze)
-("Bahamas" . bhs)
-("Bahrain" . bhr)
-("Bangladesh" . bgd)
-("Barbados" . brb)
-("Belarus" . blr)
-("Belgium" . bel)
-("Belize" . blz)
-("Benin" . ben)
-("Bermuda" . bmu)
-("Bhutan" . btn)
-("Bolivia" . bol)
-("Bonaire" . bes)
-("Sint Eustatius" . bes)
-("Saba" . bes)
-("Bosnia and Herzegovina" . bih)
-("Botswana" . bwa)
-("Bouvet Island" . bvt)
-("Brazil" . bra)
-("British Indian Ocean Territory" . iot)
-("Brunei Darussalam" . brn)
-("Bulgaria" . bgr)
-("Burkina Faso" . bfa)
-("Burundi" . bdi)
-("Cabo Verde" . cpv)
-("Cambodia" . khm)
-("Cameroon" . cmr)
-("Canada" . can)
-("Cayman Islands" . cym)
-("Central African Republic" . caf)
-("Chad" . tcd)
-("Chile" . chl)
-("China" . chn)
-("Christmas Island" . cxr)
-("Cocos (Keeling) Islands" . cck)
-("Colombia" . col)
-("Comoros" . com)
-("Congo" . cog)
-("Congo" . cod)
-("Cook Islands" . cok)
-("Costa Rica" . cri)
-("Côte d'Ivoire" . civ)
-("Croatia" . hrv)
-("Cuba" . cub)
-("Curaçao" . cuw)
-("Cyprus" . cyp)
-("Czech Republic" . cze)
-("Denmark" . dnk)
-("Djibouti" . dji)
-("Dominica" . dma)
-("Dominican Republic" . dom)
-("Ecuador" . ecu)
-("Egypt" . egy)
-("El Salvador" . slv)
-("Emacs" . emc)
-("Equatorial Guinea" . gnq)
-("Eritrea" . eri)
-("Estonia" . est)
-("Ethiopia" . eth)
-("Falkland Islands" . flk)
-("Faroe Islands" . fro)
-("Fiji" . fji)
-("Finland" . fin)
-("France" . fra)
-("French Guiana" . guf)
-("French Polynesia" . pyf)
-("French Southern Territories" . atf)
-("Gabon" . gab)
-("Gambia" . gmb)
-("Georgia" . geo)
-("Germany" . deu)
-("Ghana" . gha)
-("Gibraltar" . gib)
-("Greece" . grc)
-("Greenland" . grl)
-("Grenada" . grd)
-("Guadeloupe" . glp)
-("Guam" . gum)
-("Guatemala" . gtm)
-("Guernsey" . ggy)
-("Guinea" . gin)
-("Guinea-Bissau" . gnb)
-("Guyana" . guy)
-("Haiti" . hti)
-("Heard Island and McDonald Islands" . hmd)
-("Holy See" . vat)
-("Honduras" . hnd)
-("Hong Kong" . hkg)
-("Hungary" . hun)
-("Iceland" . isl)
-("India" . ind)
-("Indonesia" . idn)
-("Iran" . irn)
-("Iraq" . irq)
-("Ireland" . irl)
-("Isle of Man" . imn)
-("Israel" . isr)
-("Italy" . ita)
-("Jamaica" . jam)
-("Japan" . jpn)
-("Jersey" . jey)
-("Jordan" . jor)
-("Kazakhstan" . kaz)
-("Kenya" . ken)
-("Kiribati" . kir)
-("North Korea" . prk)
-("South Korea" . kor)
-("Kuwait" . kwt)
-("Kyrgyzstan" . kgz)
-("Lao People's Democratic Republic" . lao)
-("Latvia" . lva)
-("Lebanon" . lbn)
-("Lesotho" . lso)
-("Liberia" . lbr)
-("Libya" . lby)
-("Liechtenstein" . lie)
-("Lithuania" . ltu)
-("Luxembourg" . lux)
-("Macao" . mac)
-("Macedonia" . mkd)
-("Madagascar" . mdg)
-("Malawi" . mwi)
-("Malaysia" . mys)
-("Maldives" . mdv)
-("Mali" . mli)
-("Malta" . mlt)
-("Marshall Islands" . mhl)
-("Martinique" . mtq)
-("Mauritania" . mrt)
-("Mauritius" . mus)
-("Mayotte" . myt)
-("Mexico" . mex)
-("Micronesia" . fsm)
-("Moldova" . mda)
-("Monaco" . mco)
-("Mongolia" . mng)
-("Montenegro" . mne)
-("Montserrat" . msr)
-("Morocco" . mar)
-("Mozambique" . moz)
-("Myanmar" . mmr)
-("Namibia" . nam)
-("Nauru" . nru)
-("Nepal" . npl)
-("Netherlands" . nld)
-("New Caledonia" . ncl)
-("New Zealand" . nzl)
-("Nicaragua" . nic)
-("Niger" . ner)
-("Nigeria" . nga)
-("Niue" . niu)
-("Norfolk Island" . nfk)
-("Northern Mariana Islands" . mnp)
-("Norway" . nor)
-("Oman" . omn)
-("Pakistan" . pak)
-("Palau" . plw)
-("Palestine" . pse)
-("Panama" . pan)
-("Papua New Guinea" . png)
-("Paraguay" . pry)
-("Peru" . per)
-("Philippines" . phl)
-("Pitcairn" . pcn)
-("Poland" . pol)
-("Portugal" . prt)
-("Puerto Rico" . pri)
-("Qatar" . qat)
-("Réunion" . reu)
-("Romania" . rou)
-("Russian Federation" . rus)
-("Rwanda" . rwa)
-("Saint Barthélemy" . blm)
-("Saint Helena, Ascension and Tristan da Cunha" . shn)
-("Saint Kitts and Nevis" . kna)
-("Saint Lucia" . lca)
-("Saint Martin" . maf)
-("Saint Pierre and Miquelon" . spm)
-("Saint Vincent and the Grenadines" . vct)
-("Samoa" . wsm)
-("San Marino" . smr)
-("Sao Tome and Principe" . stp)
-("Saudi Arabia" . sau)
-("Senegal" . sen)
-("Serbia" . srb)
-("Seychelles" . syc)
-("Sierra Leone" . sle)
-("Singapore" . sgp)
-("Sint Maarten" . sxm)
-("Slovakia" . svk)
-("Slovenia" . svn)
-("Solomon Islands" . slb)
-("Somalia" . som)
-("South Africa" . zaf)
-("South Georgia and the South Sandwich Islands" . sgs)
-("South Sudan" . ssd)
-("Spain" . esp)
-("Sri Lanka" . lka)
-("Sudan" . sdn)
-("Suriname" . sur)
-("Svalbard and Jan Mayen" . sjm)
-("Swaziland" . swz)
-("Sweden" . swe)
-("Switzerland" . che)
-("Syrian Arab Republic" . syr)
-("Taiwan" . twn)
-("Tajikistan" . tjk)
-("Tanzania" . tza)
-("Thailand" . tha)
-("Timor-Leste" . tls)
-("Togo" . tgo)
-("Tokelau" . tkl)
-("Tonga" . ton)
-("Trinidad and Tobago" . tto)
-("Tunisia" . tun)
-("Turkey" . tur)
-("Turkmenistan" . tkm)
-("Turks and Caicos Islands" . tca)
-("Tuvalu" . tuv)
-("Uganda" . uga)
-("Ukraine" . ukr)
-("United Arab Emirates" . are)
-("United Kingdom of Great Britain and Northern Ireland" . gbr)
-("United States of America" . usa)
-("United States Minor Outlying Islands" . umi)
-("Uruguay" . ury)
-("Uzbekistan" . uzb)
-("Vanuatu" . vut)
-("Venezuela" . ven)
-("Viet Nam" . vnm)
-("Virgin Islands (British)" . vgb)
-("Virgin Islands (U.S.)" . vir)
-("Wallis and Futuna" . wlf)
-("Western Sahara" . esh)
-("Yemen" . yem)
-("Zambia" . zmb)
-("Zimbabwe" . zwe))
+ ("Afghanistan" . afg)
+ ("Åland Islands" . ala)
+ ("Albania" . alb)
+ ("Algeria" . dza)
+ ("American Samoa" . asm)
+ ("Andorra" . and)
+ ("Angola" . ago)
+ ("Anguilla" . aia)
+ ("Antarctica" . ata)
+ ("Antigua and Barbuda" . atg)
+ ("Argentina" . arg)
+ ("Armenia" . arm)
+ ("Aruba" . abw)
+ ("Australia" . aus)
+ ("Austria" . aut)
+ ("Azerbaijan" . aze)
+ ("Bahamas" . bhs)
+ ("Bahrain" . bhr)
+ ("Bangladesh" . bgd)
+ ("Barbados" . brb)
+ ("Belarus" . blr)
+ ("Belgium" . bel)
+ ("Belize" . blz)
+ ("Benin" . ben)
+ ("Bermuda" . bmu)
+ ("Bhutan" . btn)
+ ("Bolivia" . bol)
+ ("Bonaire" . bes)
+ ("Sint Eustatius" . bes)
+ ("Saba" . bes)
+ ("Bosnia and Herzegovina" . bih)
+ ("Botswana" . bwa)
+ ("Bouvet Island" . bvt)
+ ("Brazil" . bra)
+ ("British Indian Ocean Territory" . iot)
+ ("Brunei Darussalam" . brn)
+ ("Bulgaria" . bgr)
+ ("Burkina Faso" . bfa)
+ ("Burundi" . bdi)
+ ("Cabo Verde" . cpv)
+ ("Cambodia" . khm)
+ ("Cameroon" . cmr)
+ ("Canada" . can)
+ ("Cayman Islands" . cym)
+ ("Central African Republic" . caf)
+ ("Chad" . tcd)
+ ("Chile" . chl)
+ ("China" . chn)
+ ("Christmas Island" . cxr)
+ ("Cocos (Keeling) Islands" . cck)
+ ("Colombia" . col)
+ ("Comoros" . com)
+ ("Congo" . cog)
+ ("Congo" . cod)
+ ("Cook Islands" . cok)
+ ("Costa Rica" . cri)
+ ("Côte d'Ivoire" . civ)
+ ("Croatia" . hrv)
+ ("Cuba" . cub)
+ ("Curaçao" . cuw)
+ ("Cyprus" . cyp)
+ ("Czech Republic" . cze)
+ ("Denmark" . dnk)
+ ("Djibouti" . dji)
+ ("Dominica" . dma)
+ ("Dominican Republic" . dom)
+ ("Ecuador" . ecu)
+ ("Egypt" . egy)
+ ("El Salvador" . slv)
+ ("Emacs" . emc)
+ ("Equatorial Guinea" . gnq)
+ ("Eritrea" . eri)
+ ("Estonia" . est)
+ ("Ethiopia" . eth)
+ ("Falkland Islands" . flk)
+ ("Faroe Islands" . fro)
+ ("Fiji" . fji)
+ ("Finland" . fin)
+ ("France" . fra)
+ ("French Guiana" . guf)
+ ("French Polynesia" . pyf)
+ ("French Southern Territories" . atf)
+ ("Gabon" . gab)
+ ("Gambia" . gmb)
+ ("Georgia" . geo)
+ ("Germany" . deu)
+ ("Ghana" . gha)
+ ("Gibraltar" . gib)
+ ("Greece" . grc)
+ ("Greenland" . grl)
+ ("Grenada" . grd)
+ ("Guadeloupe" . glp)
+ ("Guam" . gum)
+ ("Guatemala" . gtm)
+ ("Guernsey" . ggy)
+ ("Guinea" . gin)
+ ("Guinea-Bissau" . gnb)
+ ("Guyana" . guy)
+ ("Haiti" . hti)
+ ("Heard Island and McDonald Islands" . hmd)
+ ("Holy See" . vat)
+ ("Honduras" . hnd)
+ ("Hong Kong" . hkg)
+ ("Hungary" . hun)
+ ("Iceland" . isl)
+ ("India" . ind)
+ ("Indonesia" . idn)
+ ("Iran" . irn)
+ ("Iraq" . irq)
+ ("Ireland" . irl)
+ ("Isle of Man" . imn)
+ ("Israel" . isr)
+ ("Italy" . ita)
+ ("Jamaica" . jam)
+ ("Japan" . jpn)
+ ("Jersey" . jey)
+ ("Jordan" . jor)
+ ("Kazakhstan" . kaz)
+ ("Kenya" . ken)
+ ("Kiribati" . kir)
+ ("North Korea" . prk)
+ ("South Korea" . kor)
+ ("Kuwait" . kwt)
+ ("Kyrgyzstan" . kgz)
+ ("Lao People's Democratic Republic" . lao)
+ ("Latvia" . lva)
+ ("Lebanon" . lbn)
+ ("Lesotho" . lso)
+ ("Liberia" . lbr)
+ ("Libya" . lby)
+ ("Liechtenstein" . lie)
+ ("Lithuania" . ltu)
+ ("Luxembourg" . lux)
+ ("Macao" . mac)
+ ("Macedonia" . mkd)
+ ("Madagascar" . mdg)
+ ("Malawi" . mwi)
+ ("Malaysia" . mys)
+ ("Maldives" . mdv)
+ ("Mali" . mli)
+ ("Malta" . mlt)
+ ("Marshall Islands" . mhl)
+ ("Martinique" . mtq)
+ ("Mauritania" . mrt)
+ ("Mauritius" . mus)
+ ("Mayotte" . myt)
+ ("Mexico" . mex)
+ ("Micronesia" . fsm)
+ ("Moldova" . mda)
+ ("Monaco" . mco)
+ ("Mongolia" . mng)
+ ("Montenegro" . mne)
+ ("Montserrat" . msr)
+ ("Morocco" . mar)
+ ("Mozambique" . moz)
+ ("Myanmar" . mmr)
+ ("Namibia" . nam)
+ ("Nauru" . nru)
+ ("Nepal" . npl)
+ ("Netherlands" . nld)
+ ("New Caledonia" . ncl)
+ ("New Zealand" . nzl)
+ ("Nicaragua" . nic)
+ ("Niger" . ner)
+ ("Nigeria" . nga)
+ ("Niue" . niu)
+ ("Norfolk Island" . nfk)
+ ("Northern Mariana Islands" . mnp)
+ ("Norway" . nor)
+ ("Oman" . omn)
+ ("Pakistan" . pak)
+ ("Palau" . plw)
+ ("Palestine" . pse)
+ ("Panama" . pan)
+ ("Papua New Guinea" . png)
+ ("Paraguay" . pry)
+ ("Peru" . per)
+ ("Philippines" . phl)
+ ("Pitcairn" . pcn)
+ ("Poland" . pol)
+ ("Portugal" . prt)
+ ("Puerto Rico" . pri)
+ ("Qatar" . qat)
+ ("Réunion" . reu)
+ ("Romania" . rou)
+ ("Russian Federation" . rus)
+ ("Rwanda" . rwa)
+ ("Saint Barthélemy" . blm)
+ ("Saint Helena, Ascension and Tristan da Cunha" . shn)
+ ("Saint Kitts and Nevis" . kna)
+ ("Saint Lucia" . lca)
+ ("Saint Martin" . maf)
+ ("Saint Pierre and Miquelon" . spm)
+ ("Saint Vincent and the Grenadines" . vct)
+ ("Samoa" . wsm)
+ ("San Marino" . smr)
+ ("Sao Tome and Principe" . stp)
+ ("Saudi Arabia" . sau)
+ ("Senegal" . sen)
+ ("Serbia" . srb)
+ ("Seychelles" . syc)
+ ("Sierra Leone" . sle)
+ ("Singapore" . sgp)
+ ("Sint Maarten" . sxm)
+ ("Slovakia" . svk)
+ ("Slovenia" . svn)
+ ("Solomon Islands" . slb)
+ ("Somalia" . som)
+ ("South Africa" . zaf)
+ ("South Georgia and the South Sandwich Islands" . sgs)
+ ("South Sudan" . ssd)
+ ("Spain" . esp)
+ ("Sri Lanka" . lka)
+ ("Sudan" . sdn)
+ ("Suriname" . sur)
+ ("Svalbard and Jan Mayen" . sjm)
+ ("Swaziland" . swz)
+ ("Sweden" . swe)
+ ("Switzerland" . che)
+ ("Syrian Arab Republic" . syr)
+ ("Taiwan" . twn)
+ ("Tajikistan" . tjk)
+ ("Tanzania" . tza)
+ ("Thailand" . tha)
+ ("Timor-Leste" . tls)
+ ("Togo" . tgo)
+ ("Tokelau" . tkl)
+ ("Tonga" . ton)
+ ("Trinidad and Tobago" . tto)
+ ("Tunisia" . tun)
+ ("Turkey" . tur)
+ ("Turkmenistan" . tkm)
+ ("Turks and Caicos Islands" . tca)
+ ("Tuvalu" . tuv)
+ ("Uganda" . uga)
+ ("Ukraine" . ukr)
+ ("United Arab Emirates" . are)
+ ("United Kingdom of Great Britain and Northern Ireland" . gbr)
+ ("United States of America" . usa)
+ ("United States Minor Outlying Islands" . umi)
+ ("Uruguay" . ury)
+ ("Uzbekistan" . uzb)
+ ("Vanuatu" . vut)
+ ("Venezuela" . ven)
+ ("Viet Nam" . vnm)
+ ("Virgin Islands (British)" . vgb)
+ ("Virgin Islands (U.S.)" . vir)
+ ("Wallis and Futuna" . wlf)
+ ("Western Sahara" . esh)
+ ("Yemen" . yem)
+ ("Zambia" . zmb)
+ ("Zimbabwe" . zwe))
"Mapping between a string label for countries or regions, in
English, and a three-letter symbol identifying the country, as
per ISO 3166-1 alpha 3.")
-;; Taken from https://en.wikipedia.org/wiki/ISO_3166-1_alpha-3, on Feb
-;; 27, 2016
+;; Taken from https://en.wikipedia.org/wiki/Telephone_country_codes,
+;; on Jul 30, 2016
(defvar ebdb-i18n-phone-codes
'(
;; Need a different way of doing this.
@@ -764,9 +595,179 @@ per ISO 3166-1 alpha 3.")
("Zambia" . 260)
("Zanzibar" . 255)
("Zimbabwe" . 263))
-"Mapping of country names to country-code numbers.")
-;; Taken from https://en.wikipedia.org/wiki/Telephone_country_codes,
-;; on Jul 30, 2016
+ "Mapping of country names to country-code numbers.")
+
+(cl-defgeneric ebdb-read-i18n (class slots obj spec)
+ "An internationalized version of `ebdb-read'.
+
+This works the same as `ebdb-read', plus an additional argument
+SPEC. What SPEC is depends on CLASS, but might be a phone
+country code, or a country symbol, or a script symbol.
+
+This method should return a plist of slots for object creation.")
+
+(cl-defgeneric ebdb-parse-i18n (class string spec &optional slots)
+ "An internationalized version of `ebdb-parse'.
+
+This works the same as `ebdb-read', plus an additional argument
+SPEC. What SPEC is depends on CLASS, but might be a phone
+country code, or a country symbol, or a script symbol. SLOTS is
+a plist of existing slot values.
+
+This method should return a new instance of CLASS.")
+
+(cl-defgeneric ebdb-string-i18n (field spec)
+ "An internationalized version of `ebdb-string'.")
+
+(cl-defgeneric ebdb-init-field-i18n (field record spec)
+ "An internationalized version of `ebdb-init-field'.")
+
+(cl-defgeneric ebdb-delete-field-i18n (field record spec unload)
+ "An internationalized version of `ebdb-delete-field'.")
+
+(cl-defmethod ebdb-parse-i18n :around (_class _string _spec &optional _slots)
+ "Don't clobber match data when testing names."
+ (save-match-data
+ (cl-call-next-method)))
+
+;;;###autoload
+(defun ebdb-internationalize-addresses ()
+ "Go through all the EBDB contacts and \"internationalize\"
+ address fields.
+
+Essentially this just means swapping out the string country names
+for their symbol representations.")
+
+(cl-defmethod ebdb-read :extra "i18n" ((class (subclass ebdb-field-address))
+ &optional slots obj)
+ (let ((country
+ (cdr (assoc (completing-read
+ "Country: "
+ ebdb-i18n-countries nil nil
+ (when obj (car (rassoc (ebdb-address-country obj)
+ ebdb-i18n-countries))))
+ ebdb-i18n-countries))))
+ (setq slots
+ (condition-case nil
+ (ebdb-read-i18n class
+ (plist-put slots :country country) obj country)
+ (cl-no-method
+ (plist-put slots :country country))))
+ (cl-call-next-method class slots obj)))
+
+(cl-defmethod ebdb-read :extra "i18n" ((class (subclass ebdb-field-phone))
+ &optional slots obj)
+ (let ((country
+ (if obj
+ (slot-value obj 'country-code)
+ (cdr (assoc (completing-read
+ "Country/Region: "
+ ebdb-i18n-phone-codes nil nil)
+ ebdb-i18n-phone-codes))))
+ area-code)
+ ;; Obviously this whole structure thing is just poorly
+ ;; thought-out.
+ (when (consp country)
+ (cond ((numberp (car country))
+ (setq area-code (cl-second country)
+ country (car country)))
+ ((consp (car country))
+ (setq country (assoc
+ (string-to-number
+ (completing-read
+ "Choose: "
+ (mapcar (lambda (x)
+ (number-to-string (car x)))
+ country)))
+ country)
+ area-code (cl-second country))))
+ (when (consp area-code)
+ (setq area-code (string-to-number
+ (completing-read
+ "Area code: "
+ (mapcar #'number-to-string area-code))))))
+ (when area-code
+ (setq slots (plist-put slots :area-code area-code)))
+ (setq slots (plist-put slots :country-code country))
+ (setq slots
+ (condition-case nil
+ (ebdb-read-i18n class slots obj country)
+ (cl-no-method
+ slots)))
+ (cl-call-next-method class slots obj)))
+
+(cl-defmethod ebdb-string :extra "i18n" ((phone ebdb-field-phone))
+ "Internationally-aware version of `ebdb-string' for phones."
+ (let ((cc (slot-value phone 'country-code)))
+ (or (and cc
+ (condition-case nil
+ (ebdb-string-i18n phone cc)
+ (cl-no-method nil)))
+ (cl-call-next-method))))
+
+(cl-defmethod ebdb-parse :extra "i18n" ((class (subclass ebdb-field-phone))
+ (str string)
+ &optional slots)
+ (let ((cc (or (plist-get slots :country-code)
+ (and (string-match "\\`(?\\+(?\\([0-9]\\{1,3\\}\\))?[ \t]+" str)
+ (string-to-number (match-string 1 str))))))
+ (or (and cc
+ (condition-case nil
+ (ebdb-parse-i18n
+ class
+ (replace-match "" nil nil str 0)
+ cc (plist-put slots :country-code cc))
+ (cl-no-method nil)))
+ (cl-call-next-method))))
+
+;; We don't need to override the `ebdb-read' method for names. It
+;; only matters what script the name is in if the user has set
+;; `ebdb-read-name-articulate' to nil, in which case the name is
+;; passed to this `ebdb-parse' method.
+(cl-defmethod ebdb-parse :extra "i18n" ((class (subclass
ebdb-field-name-complex))
+ (string string)
+ &optional slots)
+ ;; For now, only test the first character of whatever string the
+ ;; user has entered.
+ (let ((script (unless (string-empty-p string)
+ (aref char-script-table (aref string 0)))))
+ (or (and script
+ (null (memq script ebdb-i18n-ignorable-scripts))
+ (condition-case nil
+ (ebdb-parse-i18n class string script slots)
+ (cl-no-method
+ nil)))
+ (cl-call-next-method))))
+
+(cl-defmethod ebdb-string :extra "i18n" ((name ebdb-field-name-complex))
+ (let* ((str (cl-call-next-method name))
+ (script (aref char-script-table (aref str 0))))
+ (unless (memq script ebdb-i18n-ignorable-scripts)
+ (condition-case nil
+ (setq str (ebdb-string-i18n name script))
+ (cl-no-method nil)))
+ str))
+
+(cl-defmethod ebdb-init-field :extra "i18n" ((name ebdb-field-name) &optional
record)
+ "Do additional initialization work for international names."
+ (let* ((res (cl-call-next-method name record))
+ (str (ebdb-string name))
+ (script (aref char-script-table (aref str 0))))
+ (unless (memq script ebdb-i18n-ignorable-scripts)
+ (condition-case nil
+ (ebdb-init-field-i18n name record script)
+ (cl-no-method nil)))
+ res))
+
+(cl-defmethod ebdb-delete-field :extra "i18n" ((name ebdb-field-name)
&optional record unload)
+ "Do additional deletion work for international names."
+ (let* ((str (ebdb-string name))
+ (script (aref char-script-table (aref str 0))))
+ (unless (memq script ebdb-i18n-ignorable-scripts)
+ (condition-case nil
+ (ebdb-delete-field-i18n name record script unload)
+ (cl-no-method nil))))
+ (cl-call-next-method))
(provide 'ebdb-i18n)
;;; ebdb-i18n.el ends here
diff --git a/ebdb-message.el b/ebdb-message.el
index c7210f7..8bd304e 100644
--- a/ebdb-message.el
+++ b/ebdb-message.el
@@ -28,6 +28,8 @@
(require 'message)
(require 'sendmail)
+(defvar gnus-window-to-buffer)
+
(defgroup ebdb-mua-message nil
"Message-specific EBDB customizations"
:group 'ebdb-mua)
diff --git a/ebdb-migrate.el b/ebdb-migrate.el
index 493b1df..a492a66 100644
--- a/ebdb-migrate.el
+++ b/ebdb-migrate.el
@@ -251,7 +251,7 @@ Formats are changed in timestamp and creation-date fields
from
(string-to-number (match-string 2 date))
(string-to-number (match-string 3 date))))
;; This should be fairly loud for GNU Emacs users
- (ebdb-warn "EBDB is treating %s field value %s as %s %d %d"
+ (message "EBDB is treating %s field value %s as %s %d %d"
(car field) (cdr field)
(upcase-initials
(downcase (car (rassoc (aref parsed 1)
@@ -263,7 +263,7 @@ Formats are changed in timestamp and creation-date fields
from
(string-to-number (match-string 1 date))
(string-to-number (match-string 2 date))))
;; This should be fairly loud for GNU Emacs users
- (ebdb-warn "EBDB is treating %s field value %s as %s %d %d"
+ (message "EBDB is treating %s field value %s as %s %d %d"
(car field) (cdr field)
(upcase-initials
(downcase (car (rassoc (aref parsed 1)
@@ -651,7 +651,7 @@ holding valid contacts in a previous BBDB format."
;; Migrate if `bbdb-file' is outdated.
(if migrate (setq records (ebdb-migrate records file-format)))
-
+
records))))
(provide 'ebdb-migrate)
diff --git a/ebdb-mua.el b/ebdb-mua.el
index ac5eeb6..75750b5 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -49,6 +49,8 @@
(require 'ebdb-com)
(autoload 'ebdb-snarf "ebdb-snarf")
+(autoload 'message-goto-cc "message")
+(autoload 'mail-cc "sendmail")
(eval-and-compile
(autoload 'mail-decode-encoded-word-string "mail-parse"))
diff --git a/ebdb-org.el b/ebdb-org.el
index 9489196..07ebe09 100644
--- a/ebdb-org.el
+++ b/ebdb-org.el
@@ -52,7 +52,8 @@
;;; Code:
-(require 'ebdb)
+(require 'ebdb-com)
+(require 'org)
(if (fboundp 'org-link-set-parameters)
(org-link-set-parameters "ebdb"
diff --git a/ebdb-vcard.el b/ebdb-vcard.el
index 14d2e2c..68d5a4b 100644
--- a/ebdb-vcard.el
+++ b/ebdb-vcard.el
@@ -29,6 +29,8 @@
(require 'ebdb-format)
+(autoload 'calendar-gregorian-from-absolute "calendar")
+
(defclass ebdb-formatter-vcard (ebdb-formatter)
((coding-system :initform 'utf-8-dos)
(version-string
diff --git a/ebdb.el b/ebdb.el
index 8acba96..1f02a10 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -55,13 +55,18 @@
(autoload 'widget-group-match "wid-edit")
(autoload 'ebdb-migrate-from-bbdb "ebdb-migrate")
(autoload 'eieio-customize-object "eieio-custom")
-(autoload 'calendar-gregorian-from-absolute "calendar")
(autoload 'calendar-absolute-from-gregorian "calendar")
(autoload 'calendar-make-alist "calendar")
+(autoload 'calendar-goto-date "calendar")
+(autoload 'calendar-last-day-of-month "calendar")
+(autoload 'calendar- "calendar")
+(autoload 'calendar-read "calendar")
+(autoload 'calendar-read-date "calendar")
(autoload 'diary-sexp-entry "diary-lib")
(autoload 'diary-add-to-list "diary-lib")
(autoload 'org-agenda-list "org-agenda")
(defvar ebdb-i18n-countries)
+(defvar calendar-month-name-array)
;; These are the most important internal variables, holding EBDB's
;; data structures.
@@ -409,254 +414,609 @@ 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 functionp)))
+
+(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")))
-(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.")
+(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.
-(defvar ebdb-locality-list nil
- "List of localities (towns or cities) known to EBDB.")
+Used by `ebdb-canonicalize-mail-1'. See also `ebdb-ignore-redundant-mails'."
+ :group 'ebdb-utilities
+ :type '(regexp :tag "Regexp matching sites"))
-(defvar ebdb-region-list nil
- "List of regions (states or provinces) known to EBDB.")
+(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.
-(defvar ebdb-postcode-list nil
- "List of post codes known to EBDB.")
+See also `ebdb-ignore-redundant-mails'."
+ :group 'ebdb-utilities
+ :type 'function)
-;;; Define some of our own errors. A few of these should never be
-;;; shown to the user, they're for internal flow control.
+(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)
-;; Error parent
-(define-error 'ebdb-error "EBDB error")
+;;; Record editing
-(define-error 'ebdb-duplicate-uuid "Duplicate EBDB UUID" 'ebdb-error)
+;; The following two options should be obviated by ebdb-i18n.el
+;; See http://en.wikipedia.org/wiki/Postal_address
+;;
http://www.upu.int/en/activities/addressing/postal-addressing-systems-in-member-countstateries.html
+(defcustom ebdb-address-format-list
+ '(((arg) "splrc" "@address@hidden, @%l@, address@hidden@" "@%l@")
+ ((aus) "slrpc" "@address@hidden@ %r@ address@hidden@" "@%l@")
+ ((aut due esp che)
+ "splrc" "@address@hidden @%l@ (%r)@\n%c@" "@%l@")
+ ((can) "slrcp" "@address@hidden@, address@hidden@ %p@" "@%l@")
+ ((chn) "slprc" "@address@hidden@\n%p@ address@hidden@" "@%l@") ; English
format
+ ; (("China") "cprls" "@%c @address@hidden @%l@ %s@" "@%l@") ; Chinese
format
+ ((ind) "slprc" "@address@hidden@ %p@ (%r)@\n%c@" "@%l@")
+ ((usa) "slrpc" "@address@hidden@, %r@ address@hidden@" "@%l@")
+ (t ebdb-edit-address-default ebdb-format-address-default "@%l@"))
+ "List of address editing and formatting rules for EBDB.
+Each rule is a list (IDENTIFIER EDIT FORMAT FORMAT).
+The first rule for which IDENTIFIER matches an address is used for editing
+and formatting the address.
-(define-error 'ebdb-unsynced-db "EBDB DB unsynced" 'ebdb-error)
+IDENTIFIER may be a list of countries.
+IDENTIFIER may also be a function that is called with one arg, the address
+to be used. The rule applies if the function returns non-nil.
+See `ebdb-address-continental-p' for an example.
+If IDENTIFIER is t, this rule always applies. Usually, this should be
+the last rule that becomes a fall-back (default).
-(define-error 'ebdb-disabled-db "EBDB DB disabled" 'ebdb-error)
+EDIT may be a function that is called with one argument, the address.
+See `ebdb-edit-address-default' for an example.
-(define-error 'ebdb-readonly-db "EBDB DB read-only" 'ebdb-error)
+EDIT may also be an editting format string. It is a string containing
+the five letters s, c, p, S, and C that specify the order for editing
+the five elements of an address:
-(define-error 'ebdb-unacceptable-field "EBDB record cannot accept field"
'ebdb-error)
+s streets
+l locality
+p postcode
+r region
+c country
-(define-error 'ebdb-empty "Empty value" 'ebdb-error)
+The first FORMAT of each rule is used for multi-line layout, the second FORMAT
+is used for one-line layout.
-(define-error 'ebdb-unparseable "Unparseable value" 'ebdb-error)
+FORMAT may be a function that is called with one argument, the address.
+See `ebdb-format-address-default' for an example.
-;;; Utility functions and macros
+FORMAT may also be a format string. It consists of formatting elements
+separated by a delimiter defined via the first (and last) character of FORMAT.
+Each formatting element may contain one of the following format specifiers:
-;;;###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.
+%s streets (used repeatedly for each street part)
+%l locality
+%p postcode
+%r region
+%c country
-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))
+A formatting element will be applied only if the corresponding part
+of the address is a non-empty string.
-(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))))))
+See also `ebdb-print-address-format-list'."
+ :group 'ebdb-record-edit
+ :type '(repeat (list (choice (const :tag "Default" t)
+ (function :tag "Function")
+ (repeat (string)))
+ (choice (string)
+ (function :tag "Function"))
+ (choice (string)
+ (function :tag "Function"))
+ (choice (string)
+ (function :tag "Function")))))
-(defmacro ebdb-with-exit (&rest body)
- `(condition-case nil
- ,@body
- ((quit ebdb-empty)
- nil)))
+(defcustom ebdb-continental-postcode-regexp
+ "^\\s *[A-Z][A-Z]?\\s *-\\s *[0-9][0-9][0-9]"
+ "Regexp matching continental postcodes.
+Used by address format identifier `ebdb-address-continental-p'.
+The regexp should match postcodes of the form CH-8052, NL-2300RA,
+and SE-132 54."
+ :group 'ebdb-record-edit
+ :type 'regexp)
-(defmacro ebdb-loop-with-exit (&rest body)
- "Repeat BODY, accumulating the results in a list, until the
-user either hits C-g, or enters an empty field label."
- `(let (acc)
- (catch '--ebdb-loop-exit--
- (condition-case nil
- (while t
- (push ,@body acc))
- ((quit ebdb-empty)
- (throw '--ebdb-loop-exit-- acc))))))
+(defcustom ebdb-legal-postcodes
+ '(;; empty string
+ "^$"
+ ;; Matches 1 to 6 digits.
+ "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$"
+ ;; Matches 5 digits and 3 or 4 digits.
+ "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[
\t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$"
+ ;; Match postcodes for Canada, UK, etc. (result is ("LL47" "U4B")).
+ "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$"
+ ;; Match postcodes for continental Europe. Examples "CH-8057"
+ ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")).
+ ;; Support for "NL-2300RA" added at request from Carsten Dominik
+ ;; <address@hidden>
+ "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$"
+ ;; Match postcodes from Sweden where the five digits are grouped 3+2
+ ;; at the request from Mats Lofdahl <address@hidden>.
+ ;; (result is ("SE" (133 36)))
+ "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[
\t\n]*$")
+ "List of regexps that match legal postcodes.
+Whether this is used at all depends on the variable `ebdb-check-postcode'."
+ :group 'ebdb-record-edit
+ :type '(repeat regexp))
-(defmacro ebdb-debug (&rest body)
- "Excecute 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)))
+(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))
-;;; Fields.
+(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 "[,;]" ", ")
+ (affix "[,;]" ", ")
+ (aka "[,;]" ", ")
+ (mail "[,;]" ", ")
+ (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)))
-(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."))
- :abstract t :documentation "Abstract class for EBDB fields.
- Subclass this to produce real field types.")
+(defcustom ebdb-image-path nil
+ "List of directories to search for `ebdb-image'."
+ :group 'ebdb-record-edit
+ :type '(repeat (directory)))
-(cl-defgeneric ebdb-init-field (field record)
- "Initialize FIELD.
+(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")))
-What this means is entirely dependent upon the field class in
-question. Often it involves manipulating secondary data
-structures such as label lists. If RECORD is given, it may also
-involve using FIELD as a hash value to get to RECORD.")
+(defcustom ebdb-read-name-articulate nil
+ "Specify how to read record names.
-(cl-defmethod ebdb-init-field (_field-value _record)
- "Catch-all `ebdb-init-field' method for fields.
+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.
-This method may also get called on field values that aren't
-actually `ebdb-field' instances -- for instance, plain strings.
-In those cases, assume we don't need to do anything."
- t)
+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)
-(cl-defmethod ebdb-field-readable-name ((field (subclass ebdb-field)))
- "Return a human-readable string label for this class.
+(defcustom ebdb-lastname-prefixes
+ '("von" "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))
-Mostly used for allowing users to pick which field type they want
-to add to a record."
- ;; Why is there no non-private access to this? The `class-option'
- ;; function is mentioned in the EIEIO manual, but doesn't exist.
- (eieio--class-option (find-class field) :human-readable))
+(defcustom ebdb-lastname-re
+ (concat "[- \t]*\\(\\(?:\\<"
+ (regexp-opt ebdb-lastname-prefixes)
+ ;; multiple last names concatenated by `-'
+ "\\>[- \t]+\\)?\\(?:\\w+[ \t]*-[ \t]*\\)*\\w+\\)\\'")
+ "Regexp matching the last name of a full name.
+Its first parenthetical subexpression becomes the last name."
+ :group 'ebdb-record-edit
+ :type 'regexp)
-(cl-defmethod ebdb-field-readable-name ((field ebdb-field))
- (ebdb-field-readable-name (eieio-object-class field)))
+(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))
-(cl-defmethod ebdb-field-readable-name ((_field (eql string)))
- "Value")
+(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)
-(cl-defgeneric ebdb-parse (field-class str &optional slots)
- "Attempt to construct an instance of FIELD-CLASS using STR.
+(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)
-Implementations should extract information from STR and put it
-into SLOTS, provided that SLOTS does not already contain relevant
-values (ie, parsing should not override what's already in SLOTS).
-Then call `cl-call-next-method' with the new values.")
+(defcustom ebdb-address-label-list '("home" "work" "other")
+ "List of labels for Address field."
+ :group 'ebdb-record-edit
+ :type '(repeat string))
-(cl-defmethod ebdb-parse :around (_field-class _str &optional _slots)
- (save-match-data
- (cl-call-next-method)))
+(defcustom ebdb-phone-label-list '("home" "work" "cell" "fax" "other")
+ "List of labels for Phone field."
+ :group 'ebdb-record-edit
+ :type '(repeat string))
-(cl-defmethod ebdb-parse ((field-class (subclass ebdb-field)) _str &optional
slots)
- "Create the actual field instance."
- (apply 'make-instance field-class slots))
+(defcustom ebdb-default-country "Emacs";; what do you mean, it's not a country?
+ "Default country to use if none is specified."
+ :group 'ebdb-record-edit
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Default Country")))
-(cl-defmethod ebdb-parse :before ((_field-class (subclass ebdb-field)) str
&optional _slots)
- (when (string-empty-p str)
- (signal 'ebdb-empty (list "Empty string cannot be parsed"))))
+(defcustom ebdb-check-postcode t
+ "If non-nil, require legal postcodes when entering an address.
+The format of legal postcodes is determined by the variable
+`ebdb-legal-postcodes'."
+ :group 'ebdb-record-edit
+ :type 'boolean)
-;;; Errors
+(defcustom ebdb-default-user-field 'ebdb-field-notes
+ "Default field when editing EBDB records."
+ :group 'ebdb-record-edit
+ :type '(symbol :tag "Field"))
-;; I haven't figured this out quite yet. What I want to do is avoid
-;; raising errors for *some* methods, with *some* classes; right now
-;; all errors are suppressed. It doesn't seem very easy to specialize
-;; on methods and classes here: the GENERIC argument that's passed in
-;; to the methods below is the full struct of the generic itself.
-;; Presumably I'll have to look into that struct? Or maybe I should
-;; just write bottom-level do-nothing methods for the cases where I
-;; don't want to raise an error. I guess I'll do that for
-;; `ebdb-delete-field' and `ebdb-init-field', for the base
-;; `ebdb-field' class.
+(defcustom ebdb-url-valid-schemes '("http:" "https:" "irc:")
+ "A list of strings matching schemes acceptable to
+ `ebdb-field-url' instances.
-;; (cl-defmethod cl-no-applicable-method (_generic &rest _args)
-;; "Don't raise errors for unimplemented methods."
-;; (message "All no-applicable-method errors are swallowed."))
+Strings should not be regular expressions. They should include
+the colon character."
-;; (cl-defmethod cl-no-next-method (_generic _method &rest _args)
-;; "Don't raise errors for non-existent next methods."
-;; (message "All no-next-method errors are swallowed."))
+ :group 'ebdb-record-edit
+ :type '(repeat string))
-;; There used to be a `destructor' method, but it's been marked
-;; obsolete as of 25.2. There may be a `delete-instance' method, but
-;; then again there may not. Handle it ourselves.
+(defcustom ebdb-mail-avoid-redundancy nil
+ "How to handle the name part of `ebdb-dwim-mail'.
-(cl-defgeneric ebdb-delete-field (field &optional record unload)
- "Delete FIELD.
+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)))
-Often involves un-hashing RECORD against the field value, or
-removing labels from label lists.
+(defcustom ebdb-complete-mail t
+ "If t MUA insinuation provides key binding for command `ebdb-complete-mail'."
+ :group 'ebdb-sendmail
+ :type 'boolean)
-If UNLOAD is true, it indicates that RECORD is only being
-unloaded, not actually deleted.")
+(defcustom ebdb-completion-list t
+ "Controls the behaviour of `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)))))
-(cl-defmethod ebdb-delete-field ((field ebdb-field) &optional _record _unload)
- "User-level deletion routine for FIELD.
+(defcustom ebdb-complete-mail-allow-cycling nil
+ "If non-nil cycle mail addresses when calling `ebdb-complete-mail'."
+ :group 'ebdb-sendmail
+ :type 'boolean)
-Override this to do any necessary cleanup work after FIELD is
-removed."
- (delete-instance field))
+(defcustom ebdb-complete-mail-hook nil
+ "List of functions called after a sucessful completion."
+ :group 'ebdb-sendmail
+ :type 'hook)
-(cl-defmethod ebdb-delete-field ((_field string) &optional _record _unload)
- t)
+(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)
-(cl-defmethod delete-instance ((_field ebdb-field) &rest _args)
- t)
+(defcustom ebdb-completion-display-record t
+ "If non-nil `ebdb-complete-mail' displays the EBDB record after completion."
+ :group 'ebdb-sendmail
+ :type '(choice (const :tag "Update the EBDB buffer" t)
+ (const :tag "Do not update the EBDB buffer" nil)))
-(cl-defmethod ebdb-read ((class (subclass ebdb-field)) &optional slots _obj)
- "Complete the read/object creation process for a field of CLASS.
+(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.")
-Earlier subclasses of `ebdb-field' will have read all the
-necessary values into SLOTS; this base method is simply
-responsible for creating the field object.
+(defvar ebdb-street-list nil
+ "List of streets known to EBDB.")
-The OBJ argument is used when editing existing fields: OBJ is the
-old field. By now we've sucked all the useful information out of
-it, and if this process is successful it will get deleted."
- (apply 'make-instance class slots))
+(defvar ebdb-locality-list nil
+ "List of localities (towns or cities) known to EBDB.")
-;; Generics for fields. Not all field classes will implement these
-;; methods. `ebdb-action' should raise an error (to be caught and
-;; displayed at top level) when there is no applicable action method,
-;; so we don't actually define a base method. `ebdb-notice' shouldn't
-;; raise an error if it's not implemented, so we define a do-nothing
-;; base method.
+(defvar ebdb-region-list nil
+ "List of regions (states or provinces) known to EBDB.")
-(cl-defmethod ebdb-action ((field ebdb-field) record &optional idx)
- "Do an \"action\" based on one of the functions listed in FIELD's action
slot.
+(defvar ebdb-postcode-list nil
+ "List of post codes known to EBDB.")
-If IDX is provided, it is an index indicating which of the action
-functions to call. Otherwise, call the car of the list."
- (let* ((actions (slot-value field 'actions))
- (pair (when actions
- (if idx (or (nth idx actions) (last actions)) (car actions)))))
- (when pair
- (funcall (cdr pair) record field))))
+;;; Define some of our own errors. A few of these should never be
+;;; shown to the user, they're for internal flow control.
-(cl-defgeneric ebdb-notice-field (field &optional type record)
- "\"Notice\" FIELD.
+;; Error parent
+(define-error 'ebdb-error "EBDB error")
-This means that a message involving RECORD has been viewed, or
-that a MUA has otherwise decided that something significant to
-RECORD has taken place. It is up to the class of FIELD to decide
+(define-error 'ebdb-duplicate-uuid "Duplicate EBDB UUID" '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)
+ `(condition-case nil
+ ,@body
+ ((quit ebdb-empty)
+ nil)))
+
+(defmacro ebdb-loop-with-exit (&rest body)
+ "Repeat BODY, accumulating the results in a list, until the
+user either hits C-g, or enters an empty field label."
+ `(let (acc)
+ (catch '--ebdb-loop-exit--
+ (condition-case nil
+ (while t
+ (push ,@body acc))
+ ((quit ebdb-empty)
+ (throw '--ebdb-loop-exit-- acc))))))
+
+(defmacro ebdb-debug (&rest body)
+ "Excecute 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)))
+
+;;; Fields.
+
+(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."))
+ :abstract t :documentation "Abstract class for EBDB fields.
+ Subclass this to produce real field types.")
+
+(cl-defgeneric ebdb-init-field (field record)
+ "Initialize FIELD.
+
+What this means is entirely dependent upon the field class in
+question. Often it involves manipulating secondary data
+structures such as label lists. If RECORD is given, it may also
+involve using FIELD as a hash value to get to RECORD.")
+
+(cl-defmethod ebdb-init-field (_field-value _record)
+ "Catch-all `ebdb-init-field' method for fields.
+
+This method may also get called on field values that aren't
+actually `ebdb-field' instances -- for instance, plain strings.
+In those cases, assume we don't need to do anything."
+ t)
+
+(cl-defmethod ebdb-field-readable-name ((field (subclass ebdb-field)))
+ "Return a human-readable string label for this class.
+
+Mostly used for allowing users to pick which field type they want
+to add to a record."
+ ;; Why is there no non-private access to this? The `class-option'
+ ;; function is mentioned in the EIEIO manual, but doesn't exist.
+ (eieio--class-option (find-class field) :human-readable))
+
+(cl-defmethod ebdb-field-readable-name ((field ebdb-field))
+ (ebdb-field-readable-name (eieio-object-class field)))
+
+(cl-defmethod ebdb-field-readable-name ((_field (eql string)))
+ "Value")
+
+(cl-defgeneric ebdb-parse (field-class str &optional slots)
+ "Attempt to construct an instance of FIELD-CLASS using STR.
+
+Implementations should extract information from STR and put it
+into SLOTS, provided that SLOTS does not already contain relevant
+values (ie, parsing should not override what's already in SLOTS).
+Then call `cl-call-next-method' with the new values.")
+
+(cl-defmethod ebdb-parse :around (_field-class _str &optional _slots)
+ (save-match-data
+ (cl-call-next-method)))
+
+(cl-defmethod ebdb-parse ((field-class (subclass ebdb-field)) _str &optional
slots)
+ "Create the actual field instance."
+ (apply 'make-instance field-class slots))
+
+(cl-defmethod ebdb-parse :before ((_field-class (subclass ebdb-field)) str
&optional _slots)
+ (when (string-empty-p str)
+ (signal 'ebdb-empty (list "Empty string cannot be parsed"))))
+
+;;; Errors
+
+;; I haven't figured this out quite yet. What I want to do is avoid
+;; raising errors for *some* methods, with *some* classes; right now
+;; all errors are suppressed. It doesn't seem very easy to specialize
+;; on methods and classes here: the GENERIC argument that's passed in
+;; to the methods below is the full struct of the generic itself.
+;; Presumably I'll have to look into that struct? Or maybe I should
+;; just write bottom-level do-nothing methods for the cases where I
+;; don't want to raise an error. I guess I'll do that for
+;; `ebdb-delete-field' and `ebdb-init-field', for the base
+;; `ebdb-field' class.
+
+;; (cl-defmethod cl-no-applicable-method (_generic &rest _args)
+;; "Don't raise errors for unimplemented methods."
+;; (message "All no-applicable-method errors are swallowed."))
+
+;; (cl-defmethod cl-no-next-method (_generic _method &rest _args)
+;; "Don't raise errors for non-existent next methods."
+;; (message "All no-next-method errors are swallowed."))
+
+;; There used to be a `destructor' method, but it's been marked
+;; obsolete as of 25.2. There may be a `delete-instance' method, but
+;; then again there may not. Handle it ourselves.
+
+(cl-defgeneric ebdb-delete-field (field &optional record unload)
+ "Delete FIELD.
+
+Often involves un-hashing RECORD against the field value, or
+removing labels from label lists.
+
+If UNLOAD is true, it indicates that RECORD is only being
+unloaded, not actually deleted.")
+
+(cl-defmethod ebdb-delete-field ((field ebdb-field) &optional _record _unload)
+ "User-level deletion routine for FIELD.
+
+Override this to do any necessary cleanup work after FIELD is
+removed."
+ (delete-instance field))
+
+(cl-defmethod ebdb-delete-field ((_field string) &optional _record _unload)
+ t)
+
+(cl-defmethod delete-instance ((_field ebdb-field) &rest _args)
+ t)
+
+(cl-defmethod ebdb-read ((class (subclass ebdb-field)) &optional slots _obj)
+ "Complete the read/object creation process for a field of CLASS.
+
+Earlier subclasses of `ebdb-field' will have read all the
+necessary values into SLOTS; this base method is simply
+responsible for creating the field object.
+
+The OBJ argument is used when editing existing fields: OBJ is the
+old field. By now we've sucked all the useful information out of
+it, and if this process is successful it will get deleted."
+ (apply 'make-instance class slots))
+
+;; Generics for fields. Not all field classes will implement these
+;; methods. `ebdb-action' should raise an error (to be caught and
+;; displayed at top level) when there is no applicable action method,
+;; so we don't actually define a base method. `ebdb-notice' shouldn't
+;; raise an error if it's not implemented, so we define a do-nothing
+;; base method.
+
+(cl-defmethod ebdb-action ((field ebdb-field) record &optional idx)
+ "Do an \"action\" based on one of the functions listed in FIELD's action
slot.
+
+If IDX is provided, it is an index indicating which of the action
+functions to call. Otherwise, call the car of the list."
+ (let* ((actions (slot-value field 'actions))
+ (pair (when actions
+ (if idx (or (nth idx actions) (last actions)) (car actions)))))
+ (when pair
+ (funcall (cdr pair) record field))))
+
+(cl-defgeneric ebdb-notice-field (field &optional type record)
+ "\"Notice\" FIELD.
+
+This means that a message involving RECORD has been viewed, or
+that a MUA has otherwise decided that something significant to
+RECORD has taken place. It is up to the class of FIELD to decide
what, if anything, to do about this.
TYPE is a further indicator of how RECORD was noticed: in normal
@@ -749,7 +1109,7 @@ process."
(cl-defmethod eieio-object-name-string ((field ebdb-field-labeled))
"Return a string which is FIELD's name."
(or (slot-value field 'object-name)
- (ebdb-field-readable-name (class-of field))))
+ (ebdb-field-readable-name (eieio-object-class field))))
;;; The obfuscated field type. This is a little goofy, but might come
;;; in handy.
@@ -1722,16 +2082,6 @@ Eventually this method will go away."
;; URL field
-(defcustom ebdb-url-valid-schemes '("http:" "https:" "irc:")
- "A list of strings matching schemes acceptable to
- `ebdb-field-url' instances.
-
-Strings should not be regular expressions. They should include
-the colon character."
-
- :group 'ebdb-record-edit
- :type '(repeat string))
-
(defvar ebdb-url-label-list '("homepage")
"List of known URL labels.")
@@ -1865,24 +2215,80 @@ record uuids.")
(with-slots (country number) field
(format "(%s) %s" country number)))
-;;; Records
+;;; The cache class
-;; The basic, abstract `ebdb-record' class should require no user
-;; interaction, and has no real user-facing fields (except for the
-;; "fields" bucket, of course). It takes care of all the fundamental
-;; setup and housekeeping automatically.
+;; This probably bears some re-thinking. It would be nice to make it
+;; behave as a "real" cache, in the sense that all the accessors are
+;; accessors on the records themselves -- the records don't need to be
+;; aware of the cache. The (probably multiple) cache classes should
+;; be parent classes, not slots on the record (or rather, the cache
+;; slot on the record comes from the cache parent class). We ask the
+;; record for information, and the cache method intercepts the call,
+;; returns the value if it has it, and if not then asks the record for
+;; the value then stores it. Ie, a real cache. Not all the cache
+;; slots would work that way, of course -- for instance. a record has
+;; no way of knowing its databases except via the cache.
-(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)
+(defclass ebdb-cache ()
+ ((name-string
+ :initarg :name-string
+ :type string
+ :initform nil
+ :documentation "The \"canonical\" name for the record, as
+ displayed in the *EBDB* buffer.")
+ (alt-names
+ :initarg :alt-names
+ :type (list-of string)
+ :initform nil
+ :documentation "A list of strings representing all other
+ alternate names for this record.")
+ (organizations
+ :initarg :organizations
+ :type list
+ :initform nil
+ :documentation
+ "A list of strings representing the organizations this record
+ is associated with.")
+ (mail-aka
+ :initarg :mail-aka
+ :type list
+ :initform nil)
+ (mail-canon
+ :initarg :mail-canon
+ :type list
+ :initform nil)
+ (sortkey
+ :initarg :sortkey
+ :type string
+ :initform nil)
+ (database
+ :initarg :database
+ :type (list-of ebdb-db)
+ :initform nil
+ :documentation
+ "The database(s) this record belongs to."))
+ ;; I'm not sure if a marker slot is still going to be necessary in
+ ;; this setup.
+ :allow-nil-initform t)
+
+;;; Records
+
+;; The basic, abstract `ebdb-record' class should require no user
+;; interaction, and has no real user-facing fields (except for the
+;; "fields" bucket, of course). It takes care of all the fundamental
+;; setup and housekeeping automatically.
+
+(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)
@@ -1911,7 +2317,7 @@ record uuids.")
:initarg :cache
:type (or null ebdb-cache)
:initform nil
- ;:accessor ebdb-record-cache
+ ;:accessor ebdb-record-cache
))
:abstract t
:allow-nil-initform t
@@ -2236,11 +2642,18 @@ or actual image data."
;; Unimplemented.
nil)
+;; See http://www.ietf.org/rfc/rfc3966.txt
(cl-defmethod ebdb-field-phone-dial ((_record ebdb-record)
(phone ebdb-field-phone))
"Make some attempt to call this PHONE number."
- ;; This won't actually work.
- (ebdb-dial-number (ebdb-string phone)))
+ (with-slots (country-code area-code number extension) phone
+ (browse-url
+ (concat
+ "tel:"
+ (when country-code (format "+%d" country-code))
+ (when area-code (number-to-string area-code))
+ number
+ (when extension (format ";ext=%d" extension))))))
(cl-defmethod ebdb-field-url-browse ((_record ebdb-record)
(field ebdb-field-url))
@@ -2388,6 +2801,9 @@ If FIELD doesn't specify a year, use the current year."
(cl-defmethod ebdb-record-organizations ((_record ebdb-record-entity))
nil)
+;; TODO: This is wrong, it will alter the database after the main body
+;; of `ebdb-record-insert-field' has run. Can we simply switch it to
+;; :before?
(cl-defmethod ebdb-record-insert-field :after ((record ebdb-record-entity)
(_mail ebdb-field-mail)
&optional _slot)
@@ -2396,6 +2812,10 @@ priority."
(let ((sorted (ebdb-sort-mails (slot-value record 'mail))))
(setf (slot-value record 'mail) sorted)))
+(defun ebdb-compose-mail (&rest args)
+ "Start composing a mail message to send."
+ (apply 'compose-mail args))
+
(cl-defmethod ebdb-field-mail-compose ((record ebdb-record-entity)
(mail ebdb-field-mail))
(ebdb-compose-mail (ebdb-dwim-mail record mail)))
@@ -3307,62 +3727,6 @@ the persistent save, or allow them to propagate."
(setf (slot-value db 'dirty) t)
(cl-call-next-method))
-;;; The cache class
-
-;; This probably bears some re-thinking. It would be nice to make it
-;; behave as a "real" cache, in the sense that all the accessors are
-;; accessors on the records themselves -- the records don't need to be
-;; aware of the cache. The (probably multiple) cache classes should
-;; be parent classes, not slots on the record (or rather, the cache
-;; slot on the record comes from the cache parent class). We ask the
-;; record for information, and the cache method intercepts the call,
-;; returns the value if it has it, and if not then asks the record for
-;; the value then stores it. Ie, a real cache. Not all the cache
-;; slots would work that way, of course -- for instance. a record has
-;; no way of knowing its databases except via the cache.
-
-(defclass ebdb-cache ()
- ((name-string
- :initarg :name-string
- :type string
- :initform nil
- :documentation "The \"canonical\" name for the record, as
- displayed in the *EBDB* buffer.")
- (alt-names
- :initarg :alt-names
- :type (list-of string)
- :initform nil
- :documentation "A list of strings representing all other
- alternate names for this record.")
- (organizations
- :initarg :organizations
- :type list
- :initform nil
- :documentation
- "A list of strings representing the organizations this record
- is associated with.")
- (mail-aka
- :initarg :mail-aka
- :type list
- :initform nil)
- (mail-canon
- :initarg :mail-canon
- :type list
- :initform nil)
- (sortkey
- :initarg :sortkey
- :type string
- :initform nil)
- (database
- :initarg :database
- :type (list-of ebdb-db)
- :initform nil
- :documentation
- "The database(s) this record belongs to."))
- ;; I'm not sure if a marker slot is still going to be necessary in
- ;; this setup.
- :allow-nil-initform t)
-
;;; Subclasses of `ebdb-db'.
;; File-based database, keeping its records in-file.
@@ -3541,411 +3905,102 @@ Returns a list of (\"label\" slot . field-class)."
(unless (or (eq field 'ebdb-field-user-simple)
(eq field 'ebdb-field-creation-date)
(eq field 'ebdb-field-timestamp))
- (push (list (ebdb-field-readable-name field) c) field-list)))
- (dolist (l ebdb-user-label-list)
- (push (list l (cons 'fields 'ebdb-field-user-simple)) field-list))
- (setq choice
- (completing-read
- "Choose field type: "
- field-list))
- (or (assoc choice field-list)
- (list choice (cons 'fields 'ebdb-field-user-simple)))))
-
-(defun ebdb-prompt-for-db (&optional db-list)
- (unless (or db-list ebdb-db-list)
- (ebdb-load))
- (let* ((collection (or db-list ebdb-db-list))
- (db-string
- (ebdb-read-string "Choose a database: "
- nil
- (mapcar
- (lambda (d)
- (slot-value d 'object-name))
- collection)
- t)))
- (object-assoc db-string 'object-name collection)))
-
-(defun ebdb-prompt-for-mail (record)
- (let ((mail-alist (mapcar
- (lambda (m) (cons (ebdb-string m) m))
- (ebdb-record-mail record t))))
- (cdr (if (= 1 (length mail-alist))
- (car mail-alist)
- (assoc (ebdb-read-string
- (format "Mail address for %s: " (ebdb-string record))
- nil mail-alist t)
- mail-alist)))))
-
-(defun ebdb-dirty-records (&optional records)
- "Return all records with unsaved changes.
-
-If RECORDS are given, only search those records."
- (seq-filter
- (lambda (r)
- (slot-value r 'dirty))
- (or records ebdb-record-tracker)))
-
-;;; Getters
-
-;; The simplest of getters/setters are defined with an :accessor tag
-;; on the class slot definition itself. Ie, `ebdb-record-user-fields'
-;; and `ebdb-record-cache'.
-
-(defun ebdb-record-cache (record)
- (slot-value record 'cache))
-
-(defun ebdb-record-user-fields (record)
- (slot-value record 'fields))
-
-(defun ebdb-record-user-field (record label)
- (object-assoc (if (stringp label)
- label
- (symbol-name label))
- 'object-name (ebdb-record-user-fields record)))
-
-(defun ebdb-record-address (record &optional label)
- (let ((addresses (slot-value record 'address)))
- (if label
- (object-assoc label 'object-name addresses)
- addresses)))
-
-(defun ebdb-record-phone (record &optional label)
- (let ((phones (slot-value record 'phone)))
- (if label
- (object-assoc label 'object-name phones)
- phones)))
-
-(defun ebdb-record-mail (record &optional roles label defunct)
- "Return a list of all RECORD's mail fields.
-
-If ROLES is non-nil, also consider mail fields from RECORD's
-roles. If LABEL is a string, return the mail with that label.
-If DEFUNCT is non-nil, also consider RECORD's defunct mail
-addresses."
- (let ((mails (slot-value record 'mail)))
- (when (and roles (slot-exists-p record 'organizations))
- (dolist (r (slot-value record 'organizations))
- (when (and (slot-value r 'mail)
- (or defunct
- (null (slot-value r 'defunct))))
- (push (slot-value r 'mail) mails))))
- (unless defunct
- (setq mails
- (seq-filter (lambda (m)
- (null (eq (slot-value m 'priority) 'defunct)))
- mails)))
- (if label
- (object-assoc label 'object-name mails)
- mails)))
-
-
-;;; Record editing
-
-;; The following two options should be obviated by ebdb-i18n.el
-;; See http://en.wikipedia.org/wiki/Postal_address
-;;
http://www.upu.int/en/activities/addressing/postal-addressing-systems-in-member-countstateries.html
-(defcustom ebdb-address-format-list
- '(((arg) "splrc" "@address@hidden, @%l@, address@hidden@" "@%l@")
- ((aus) "slrpc" "@address@hidden@ %r@ address@hidden@" "@%l@")
- ((aut due esp che)
- "splrc" "@address@hidden @%l@ (%r)@\n%c@" "@%l@")
- ((can) "slrcp" "@address@hidden@, address@hidden@ %p@" "@%l@")
- ((chn) "slprc" "@address@hidden@\n%p@ address@hidden@" "@%l@") ; English
format
- ; (("China") "cprls" "@%c @address@hidden @%l@ %s@" "@%l@") ; Chinese
format
- ((ind) "slprc" "@address@hidden@ %p@ (%r)@\n%c@" "@%l@")
- ((usa) "slrpc" "@address@hidden@, %r@ address@hidden@" "@%l@")
- (t ebdb-edit-address-default ebdb-format-address-default "@%l@"))
- "List of address editing and formatting rules for EBDB.
-Each rule is a list (IDENTIFIER EDIT FORMAT FORMAT).
-The first rule for which IDENTIFIER matches an address is used for editing
-and formatting the address.
-
-IDENTIFIER may be a list of countries.
-IDENTIFIER may also be a function that is called with one arg, the address
-to be used. The rule applies if the function returns non-nil.
-See `ebdb-address-continental-p' for an example.
-If IDENTIFIER is t, this rule always applies. Usually, this should be
-the last rule that becomes a fall-back (default).
-
-EDIT may be a function that is called with one argument, the address.
-See `ebdb-edit-address-default' for an example.
-
-EDIT may also be an editting format string. It is a string containing
-the five letters s, c, p, S, and C that specify the order for editing
-the five elements of an address:
-
-s streets
-l locality
-p postcode
-r region
-c country
-
-The first FORMAT of each rule is used for multi-line layout, the second FORMAT
-is used for one-line layout.
-
-FORMAT may be a function that is called with one argument, the address.
-See `ebdb-format-address-default' for an example.
-
-FORMAT may also be a format string. It consists of formatting elements
-separated by a delimiter defined via the first (and last) character of FORMAT.
-Each formatting element may contain one of the following format specifiers:
-
-%s streets (used repeatedly for each street part)
-%l locality
-%p postcode
-%r region
-%c country
-
-A formatting element will be applied only if the corresponding part
-of the address is a non-empty string.
-
-See also `ebdb-print-address-format-list'."
- :group 'ebdb-record-edit
- :type '(repeat (list (choice (const :tag "Default" t)
- (function :tag "Function")
- (repeat (string)))
- (choice (string)
- (function :tag "Function"))
- (choice (string)
- (function :tag "Function"))
- (choice (string)
- (function :tag "Function")))))
-
-(defcustom ebdb-continental-postcode-regexp
- "^\\s *[A-Z][A-Z]?\\s *-\\s *[0-9][0-9][0-9]"
- "Regexp matching continental postcodes.
-Used by address format identifier `ebdb-address-continental-p'.
-The regexp should match postcodes of the form CH-8052, NL-2300RA,
-and SE-132 54."
- :group 'ebdb-record-edit
- :type 'regexp)
-
-(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 "[,;]" ", ")
- (affix "[,;]" ", ")
- (aka "[,;]" ", ")
- (mail "[,;]" ", ")
- (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-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" "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)
- ;; multiple last names concatenated by `-'
- "\\>[- \t]+\\)?\\(?:\\w+[ \t]*-[ \t]*\\)*\\w+\\)\\'")
- "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-default-domain nil
- "Default domain to append when reading a new mail address.
-If a mail address does not contain address@hidden', append
@`ebdb-default-domain' to it.
-
-The address is not altered if `ebdb-default-domain' is nil
-or if a prefix argument is given to the command `ebdb-insert-field'."
- :group 'ebdb-record-edit
- :type '(choice (const :tag "none" nil)
- (string :tag "Default Domain")))
-
-(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-default-label-list '("home" "work" "other")
- "Default list of labels for Address and Phone fields."
- :group 'ebdb-record-edit
- :type '(repeat string))
-
-(defcustom ebdb-address-label-list ebdb-default-label-list
- "List of labels for Address field."
- :group 'ebdb-record-edit
- :type '(repeat string))
+ (push (list (ebdb-field-readable-name field) c) field-list)))
+ (dolist (l ebdb-user-label-list)
+ (push (list l (cons 'fields 'ebdb-field-user-simple)) field-list))
+ (setq choice
+ (completing-read
+ "Choose field type: "
+ field-list))
+ (or (assoc choice field-list)
+ (list choice (cons 'fields 'ebdb-field-user-simple)))))
-(defcustom ebdb-phone-label-list '("home" "work" "cell" "fax" "other")
- "List of labels for Phone field."
- :group 'ebdb-record-edit
- :type '(repeat string))
+(defun ebdb-prompt-for-db (&optional db-list)
+ (unless (or db-list ebdb-db-list)
+ (ebdb-load))
+ (let* ((collection (or db-list ebdb-db-list))
+ (db-string
+ (ebdb-read-string "Choose a database: "
+ nil
+ (mapcar
+ (lambda (d)
+ (slot-value d 'object-name))
+ collection)
+ t)))
+ (object-assoc db-string 'object-name collection)))
-(defcustom ebdb-default-country "Emacs";; what do you mean, it's not a country?
- "Default country to use if none is specified."
- :group 'ebdb-record-edit
- :type '(choice (const :tag "None" nil)
- (string :tag "Default Country")))
+(defun ebdb-prompt-for-mail (record)
+ (let ((mail-alist (mapcar
+ (lambda (m) (cons (ebdb-string m) m))
+ (ebdb-record-mail record t))))
+ (cdr (if (= 1 (length mail-alist))
+ (car mail-alist)
+ (assoc (ebdb-read-string
+ (format "Mail address for %s: " (ebdb-string record))
+ nil mail-alist t)
+ mail-alist)))))
-(defcustom ebdb-check-postcode t
- "If non-nil, require legal postcodes when entering an address.
-The format of legal postcodes is determined by the variable
-`ebdb-legal-postcodes'."
- :group 'ebdb-record-edit
- :type 'boolean)
+(defun ebdb-dirty-records (&optional records)
+ "Return all records with unsaved changes.
-(defcustom ebdb-legal-postcodes
- '(;; empty string
- "^$"
- ;; Matches 1 to 6 digits.
- "^[ \t\n]*[0-9][0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[ \t\n]*$"
- ;; Matches 5 digits and 3 or 4 digits.
- "^[ \t\n]*\\([0-9][0-9][0-9][0-9][0-9]\\)[ \t\n]*-?[
\t\n]*\\([0-9][0-9][0-9][0-9]?\\)[ \t\n]*$"
- ;; Match postcodes for Canada, UK, etc. (result is ("LL47" "U4B")).
- "^[ \t\n]*\\([A-Za-z0-9]+\\)[ \t\n]+\\([A-Za-z0-9]+\\)[ \t\n]*$"
- ;; Match postcodes for continental Europe. Examples "CH-8057"
- ;; or "F - 83320" (result is ("CH" "8057") or ("F" "83320")).
- ;; Support for "NL-2300RA" added at request from Carsten Dominik
- ;; <address@hidden>
- "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+ ?[A-Z]*\\)[ \t\n]*$"
- ;; Match postcodes from Sweden where the five digits are grouped 3+2
- ;; at the request from Mats Lofdahl <address@hidden>.
- ;; (result is ("SE" (133 36)))
- "^[ \t\n]*\\([A-Z]+\\)[ \t\n]*-?[ \t\n]*\\([0-9]+\\)[ \t\n]+\\([0-9]+\\)[
\t\n]*$")
- "List of regexps that match legal postcodes.
-Whether this is used at all depends on the variable `ebdb-check-postcode'."
- :group 'ebdb-record-edit
- :type '(repeat regexp))
+If RECORDS are given, only search those records."
+ (seq-filter
+ (lambda (r)
+ (slot-value r 'dirty))
+ (or records ebdb-record-tracker)))
-(defcustom ebdb-default-user-field 'ebdb-field-notes
- "Default field when editing EBDB records."
- :group 'ebdb-record-edit
- :type '(symbol :tag "Field"))
+;;; Getters
-
+;; TODO: Use :accessor tags for the simple cases.
-(defcustom ebdb-mail-avoid-redundancy nil
- "How to handle the name part of `ebdb-dwim-mail'.
+(defun ebdb-record-cache (record)
+ (slot-value record 'cache))
-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)))
+(defun ebdb-record-user-fields (record)
+ (slot-value record 'fields))
-(defcustom ebdb-complete-mail t
- "If t MUA insinuation provides key binding for command `ebdb-complete-mail'."
- :group 'ebdb-sendmail
- :type 'boolean)
+(defun ebdb-record-user-field (record label)
+ (object-assoc (if (stringp label)
+ label
+ (symbol-name label))
+ 'object-name (ebdb-record-user-fields record)))
-(defcustom ebdb-completion-list t
- "Controls the behaviour of `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)))))
+(defun ebdb-record-address (record &optional label)
+ (let ((addresses (slot-value record 'address)))
+ (if label
+ (object-assoc label 'object-name addresses)
+ addresses)))
-(defcustom ebdb-complete-mail-allow-cycling nil
- "If non-nil cycle mail addresses when calling `ebdb-complete-mail'."
- :group 'ebdb-sendmail
- :type 'boolean)
+(defun ebdb-record-phone (record &optional label)
+ (let ((phones (slot-value record 'phone)))
+ (if label
+ (object-assoc label 'object-name phones)
+ phones)))
-(defcustom ebdb-complete-mail-hook nil
- "List of functions called after a sucessful completion."
- :group 'ebdb-sendmail
- :type 'hook)
+(defun ebdb-record-mail (record &optional roles label defunct)
+ "Return a list of all RECORD's mail fields.
-(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)
+If ROLES is non-nil, also consider mail fields from RECORD's
+roles. If LABEL is a string, return the mail with that label.
+If DEFUNCT is non-nil, also consider RECORD's defunct mail
+addresses."
+ (let ((mails (slot-value record 'mail)))
+ (when (and roles (slot-exists-p record 'organizations))
+ (dolist (r (slot-value record 'organizations))
+ (when (and (slot-value r 'mail)
+ (or defunct
+ (null (slot-value r 'defunct))))
+ (push (slot-value r 'mail) mails))))
+ (unless defunct
+ (setq mails
+ (seq-filter (lambda (m)
+ (null (eq (slot-value m 'priority) 'defunct)))
+ mails)))
+ (if label
+ (object-assoc label 'object-name mails)
+ mails)))
-(defcustom ebdb-completion-display-record t
- "If non-nil `ebdb-complete-mail' displays the EBDB record after completion."
- :group 'ebdb-sendmail
- :type '(choice (const :tag "Update the EBDB buffer" t)
- (const :tag "Do not update the EBDB buffer" nil)))
+
(defun ebdb-dwim-mail (record &optional mail)
;; Do What I Mean!
@@ -3997,60 +4052,6 @@ RECORD. If MAIL is nil use RECORD's primary mail
address."
;;; Dialing and texting.
-(defcustom ebdb-dial-local-prefix-alist
- '(((if (integerp ebdb-default-area-code)
- (format "(%03d)" ebdb-default-area-code)
- (or ebdb-default-area-code ""))
- . ""))
- "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 'ebdb-utilities-dialing
- :type 'sexp)
-
-(defcustom ebdb-dial-local-prefix nil
- "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.) In EBDB's
-opinion, you're dialing a local number if it starts with a 0 after
-processing `ebdb-dial-local-prefix-alist'."
- :group 'ebdb-utilities-dialing
- :type '(choice (const :tag "No digits required" nil)
- (string :tag "Dial this first" "9")))
-
-(defcustom ebdb-dial-long-distance-prefix nil
- "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. Note that this is used to replace the + sign in phone numbers
-when dialling (international dialing prefix.)"
- :group 'ebdb-utilities-dialing
- :type '(choice (const :tag "No digits required" nil)
- (string :tag "Dial this first" "1")))
-
-(defcustom ebdb-dial-function nil
- "If non-nil this should be a function used for dialing phone numbers.
-This function is used by `ebdb-dial-number'. It requires one
-argument which is a string for the number that is dialed.
-If nil then `ebdb-dial-number' uses the tel URI syntax passed to `browse-url'
-to make the call."
- :group 'ebdb-utilities-dialing
- :type 'function)
-
-;; Signal integration.
-
-(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)
-
(defun ebdb-signal-get-number (record &optional no-prompt)
"Extract a usable Signal number from RECORD.
@@ -4113,37 +4114,6 @@ command's docstring for more details."
(ebdb--signal-text sender message recipients attachments)
(message "Please set `ebdb-signal-program'"))))
-(defun ebdb-signal-text (sender records message attachments)
- "Compose and send a text message using the Signal protocol.
-
-SENDER should be a phone number (with leading \"+\") to send
-from. If `ebdb-record-self' is set, this record will be used as
-the sender, while RECORDS will be used as the list of recipients.
-In both cases, `ebdb-signal-get-number' will be used to find a
-usable number from the record.
-
-MESSAGE is the string to send as the body of the text message.
-ATTACHMENTS is a list of filenames to send as attachments on the
-message."
- (interactive
- (list (or (and ebdb-record-self
- (ebdb-signal-get-number
- (ebdb-gethash ebdb-record-self 'uuid)
- t))
- (ebdb-read-string
- "Number to send from (or set `ebdb-record-self'): "))
- (ebdb-do-records)
- (ebdb-read-string "Message contents: ")
- (ebdb-loop-with-exit
- (expand-file-name
- (read-file-name "Attach file (C-g when done): "
- nil nil nil)))))
- (let ((recipients
- (delq nil (mapcar #'ebdb-signal-get-number records))))
- (if ebdb-signal-program
- (ebdb--signal-text sender message recipients attachments)
- (message "Please set `ebdb-signal-program'"))))
-
(defun ebdb--signal-text (sender message recipients &optional attachments)
"Internal function for actually sending the SMS."
(let ((command
@@ -4160,12 +4130,6 @@ message."
;;; Helper functions
-(defun ebdb-warn (&rest args)
- "Display a message at the bottom of the screen.
-ARGS are passed to `message'."
- (ding t)
- (apply 'message args))
-
(defun ebdb-string-trim (string &optional null)
"Remove leading and trailing whitespace and all properties from STRING.
If STRING is nil return an empty string unless NULL is non-nil."
@@ -4346,38 +4310,6 @@ and canonical addresses in the mail field of EBDB
records."
;;; Massage of mail addresses
-(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)
-
(defun ebdb-canonicalize-mail-1 (address)
"Example of `ebdb-canonicalize-mail-function'.
However, this function is too specific to be useful for the general user.
@@ -4489,21 +4421,6 @@ This strips garbage from the user full NAME string."
;; `ebdb-hash-record' for each record. This function is also called
;; when new records are added to the database.
-(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 functionp)))
-
(defun ebdb-puthash (key record)
"Associate RECORD with KEY in `ebdb-hashtable'.
KEY must be a string or nil. Empty strings and nil are ignored."
@@ -4880,7 +4797,7 @@ The formatting rules are defined in
`ebdb-address-format-list'."
(defun ebdb-cite-records (&optional records arg)
(interactive (list (ebdb-prompt-for-record)
current-prefix-arg))
- (let ((recs (ebdb-record-list records))
+ (let ((recs (if (listp records) records (list records)))
(style (if arg 'list 'inline))
usable)
(dolist (r recs)
@@ -4899,7 +4816,7 @@ differently by different major modes.
This is a generic function that dispatches on the value of
`major-mode'. It only inserts names and mail addresses.")
-(cl-defmethod ebdb-records-cite (style records)
+(cl-defmethod ebdb-records-cite (_style records)
"The fallback catch-all method."
(when records
(mapcar (lambda (pair)
@@ -4909,8 +4826,8 @@ This is a generic function that dispatches on the value of
records)))
(cl-defmethod ebdb-records-cite :around ((_style (eql list))
- (_records list)
- &context (major-mode org-mode))
+ (_records list)
+ &context (major-mode org-mode))
(let ((list (cl-call-next-method)))
(mapconcat (lambda (elt)
(format "- %s" elt))
@@ -4926,15 +4843,15 @@ This is a generic function that dispatches on the value
of
records))
(cl-defmethod ebdb-records-cite :around ((_style (eql list))
- (_records list)
- &context (major-mode html-mode))
+ (_records list)
+ &context (major-mode html-mode))
(let ((list (cl-call-next-method)))
(mapconcat (lambda (l)
(format "<li>%s</li>" l))
list "\n")))
(cl-defmethod ebdb-records-cite :around ((_style (eql inline))
- (_records list))
+ (_records list))
(let ((list (cl-call-next-method)))
(mapconcat #'identity list " ")))
@@ -4979,6 +4896,9 @@ With prefix ARG, insert string at point."
;;; Searching EBDB
+(defvar ebdb-search-invert nil
+ "Bind this variable to t in order to invert the result of `ebdb-search'.")
+
(defun ebdb-message-search (name mail)
"Return list of EBDB records matching NAME and/or MAIL.
First try to find a record matching both NAME and MAIL.
@@ -5051,7 +4971,7 @@ interpreted as t, ie the record passes."
FIELD.")
(cl-defgeneric ebdb-record-search (record type criterion)
- "Return t if CRITERION matches RECORD, given STYLE.")
+ "Return t if CRITERION matches RECORD, given TYPE.")
(cl-defmethod ebdb-field-search ((field ebdb-field) (regex string))
(condition-case nil
diff --git a/helm-ebdb.el b/helm-ebdb.el
index ae1fbbc..53f4199 100644
--- a/helm-ebdb.el
+++ b/helm-ebdb.el
@@ -63,7 +63,7 @@
(defun helm-ebdb-cite-records (candidate)
"Insert Name <email> string for CANDIDATE or marked candidate."
(let ((recs (or (helm-marked-candidates) (list candidate))))
- (ebdb-cite-records-mail recs)))
+ (ebdb-cite-records recs)))
(defvar helm-source-ebdb
'((name . "EBDB")
- [elpa] externals/ebdb 2c9d491 323/350: Rework snarf collection, (continued)
- [elpa] externals/ebdb 2c9d491 323/350: Rework snarf collection, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb f466e6e 342/350: Add some country name "shorthands", Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 26ee1cb 330/350: Refactor snarfing, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 6cc67a7 315/350: Add instructions for writing i18n libraries to manual, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb c11ef0e 334/350: Rename ebdb-message-header to ebdb-mua-message-header, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 7dd034d 349/350: Fix up record citation, bind a command in EBDB mode, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 615ed9a 326/350: Prefix arg to article snarfing only snarfs signature, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 8776051 341/350: Changes to manual and README, reflecting EBDB's move to ELPA, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 80ce330 340/350: Remove libraries that will live in separate packages, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb bc3c712 332/350: Move "Writing Internationalization Libraries" in manual, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 3210ad7 338/350: Compiler-inspired fixes version 443992,
Eric Abrahamsen <=
- [elpa] externals/ebdb d7bc0c9 284/350: Drop the whole auto-notes thing, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb b25edb9 002/350: Squash "prep" branch, push to Github, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 4bdf47e 263/350: Get notice routine working, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 9ce8e30 310/350: Check db editable before reading new record, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb a4d11f5 293/350: Modify ebdb-mua-yank-cc to yank from any EBDB buffer, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 7caa1b4 308/350: Fix bug in reading mail alias fields, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb f987d46 305/350: Fix buffer modification call, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb c890b24 296/350: Mention mail aliases in the manual, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb be9464d 319/350: When merging organization records, possibly merge role fields, Eric Abrahamsen, 2017/08/14
- [elpa] externals/ebdb 969c44c 303/350: Small tweaks to README, Eric Abrahamsen, 2017/08/14