[elpa] externals/ebdb e4c0442 162/350: Fix up actions and EBDB buffer menus

[Eric Abrahamsen]

branch: externals/ebdb
commit e4c0442429faf2a17796aa136af5500ec5851dcf
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Fix up actions and EBDB buffer menus
    
    * ebdb.el (ebdb-field): Define actions as a list of ("Descriptive
      string" . function-name) elements.  Change all field class
      definitions accordingly.
      (ebdb-action): Edit accordingly.
      (ebdb-field-relation): Make this an action, not a separate function.
      (ebdb-field-anniversary-calendar, ebdb-field-anniversary-agenda):
      Give anniversary fields two distinct actions.
    * ebdb-com.el (ebdb-insert-field-menu): Fix field insertion menu.
      (ebdb-record-action): Call action functions directly.
      (ebdb-field-menu): Extract action bits accordingly.
      (ebdb-mode-map): Use RET to call actions, not "a".
---
 ebdb-com.el | 61 ++++++++++++++++++++++++++++++++++++-------------------------
 ebdb.el     | 46 ++++++++++++++++++++++++++++------------------
 2 files changed, 64 insertions(+), 43 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index 2ffa1c7..9117844 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -249,7 +249,7 @@ display information."
 (defvar ebdb-mode-map
   (let ((km (make-sparse-keymap)))
     (define-key km (kbd "!")           'ebdb-search-invert)
-    (define-key km (kbd "a")           'ebdb-record-action)
+    (define-key km (kbd "RET")         'ebdb-record-action)
     (define-key km (kbd "A")           'ebdb-mail-aliases)
     (define-key km (kbd "c")           'ebdb-create-record)
     (define-key km (kbd "C")           'ebdb-create-record-extended)
@@ -273,7 +273,6 @@ display information."
     (define-key km (kbd "f")           'ebdb-format-to-tmp-buffer)
     (define-key km (kbd "C-k")         'ebdb-delete-field-or-record)
     (define-key km (kbd "i")           'ebdb-insert-field)
-    (define-key km (kbd "RET")         'ebdb-follow-related)
     (define-key km (kbd "s")           'ebdb-save)
     (define-key km (kbd "C-x C-s")     'ebdb-save)
     (define-key km (kbd "t")           'ebdb-toggle-records-format)
@@ -1121,16 +1120,14 @@ There are numerous hooks.  M-x apropos ^ebdb.*hook RET
                `(ebdb-compose-mail ,(ebdb-dwim-mail record (car mails)))
                t)))))
 
-(defun ebdb-field-menu (_record field)
+(defun ebdb-field-menu (record field)
   "Menu items specifically for FIELD of RECORD."
   (append
    (list (format "Commands for %s Field:"
                 (capitalize (ebdb-field-readable-name field))))
    (mapcar
     (lambda (a)
-      ;; Yuck.  Guess I'll have to give action functions a string
-      ;; name.
-      (vector (symbol-name a) a t))
+      (vector (car a) `(funcall ,(symbol-function (cdr a)) ,record ,field) t))
     (slot-value field 'actions))
    '(["Edit Field" ebdb-edit-field t]
      ["Edit Field Customize" ebdb-edit-field-customize t]
@@ -1140,19 +1137,14 @@ There are numerous hooks.  M-x apropos ^ebdb.*hook RET
   "Submenu for inserting a new field for RECORD."
   (cons "Insert New Field..."
         (mapcar
-         (lambda (field)
-           (if (stringp field) field
-             (vector (symbol-name field)
-                     `(ebdb-insert-field
-                       ,record ',field (ebdb-read-field ,record ',field
-                                                        ,current-prefix-arg))
-                     (not (or (and (eq field 'organization)
-                                   (ebdb-record-organizations record))
-                              (and (eq field 'mail) (ebdb-record-mail record))
-                              (and (eq field 'aka) (ebdb-record-aka record))
-                              (assq field (ebdb-record-user-fields 
record)))))))
-         (append '(affix organization aka phone address mail)
-                 '("--") ebdb-user-label-list))))
+         (lambda (pair)
+          (vector (ebdb-field-readable-name (cdr pair))
+                  `(ebdb-record-insert-field
+                   ,record ',(car pair)
+                   (ebdb-read ,(cdr pair)))
+                  t))
+        (ebdb-record-field-slot-query
+         (eieio-object-class record)))))
 
 (defun ebdb-mouse-menu (event)
   "EBDB mouse menu for EVENT,"
@@ -2688,14 +2680,33 @@ of all of these people."
 
 ;;; Actions
 
-(defun ebdb-record-action (arg record field)
+(defun ebdb-record-action (record field action)
   "Ask FIELD of RECORD to perform an action.
 
-With ARG, use ARG an an index into FIELD's list of actions."
-  (interactive (list current-prefix-arg
-                    (ebdb-current-record)
-                    (ebdb-current-field)))
-  (ebdb-action field record arg))
+With the prefix arg, use it an an index into FIELD's list of
+actions."
+  (interactive
+   (let* ((rec (ebdb-current-record))
+         (field (ebdb-current-field))
+         (actions (slot-value field 'actions))
+         (action
+          (when actions
+            (if (= 1 (length actions))
+                (cdar actions)
+              (if current-prefix-arg
+                  (or (cdr-safe (nth current-prefix-arg actions))
+                      (cdar actions))
+                (let ((alst (mapcar
+                             (lambda (a)
+                               (cons (first a) (cdr a)))
+                             actions)))
+                  (cdr
+                   (assoc (completing-read "Action: " alst)
+                          alst))))))))
+     (list rec field action)))
+  (if action
+      (funcall action record field)
+    (message "No action for field")))
 
 
 ;;; Dialing numbers from EBDB
diff --git a/ebdb.el b/ebdb.el
index 58a015f..14fe17b 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -63,7 +63,8 @@
   (autoload 'eieio-customize-object "eieio-custom")
   (autoload 'calendar-gregorian-from-absolute "calendar")
   (autoload 'calendar-read-date "calendar")
-  (autoload 'diary-sexp-entry "diary-lib"))
+  (autoload 'diary-sexp-entry "diary-lib")
+  (autoload 'org-agenda-list "org-agenda"))
 
 ;; These are the most important internal variables, holding EBDB's
 ;; data structures.
@@ -491,14 +492,14 @@ You really should not disable debugging.  But it will 
speed things up."
 
 (defclass ebdb-field ()
   ((actions
-    :type (list-of function)
+    :type (list-of cons)
     :allocation :class
     :initform nil
     :documentation
-    "A list of actions which this field can perform."))
-  :abstract t
-  :documentation "Abstract class for EBDB fields.  Subclass this
-to produce real field types.")
+    "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.
@@ -623,10 +624,10 @@ it, and if this process is successful it will get 
deleted."
 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))
-        (func (when actions
+        (pair (when actions
                 (if idx (or (nth idx actions) (last actions)) (car actions)))))
-    (when func
-      (funcall func record field))))
+    (when pair
+      (funcall (cdr pair) record field))))
 
 (cl-defmethod ebdb-notice ((_field ebdb-field) &optional _type 
_message-headers _record)
   "Ask FIELD of RECORD to react to RECORD being \"noticed\".
@@ -1085,7 +1086,7 @@ first one."
     offered for completion, and 'primary means this address will
     be used as the default.  Only one of a record's addresses can
     be set to 'primary.")
-   (actions :initform '(ebdb-field-mail-compose)))
+   (actions :initform '(("Compose mail" . ebdb-field-mail-compose))))
   :documentation "A field representing a single email address.
   The optional \"object-name\" slot can serve as a mail aka."
   :human-readable "mail")
@@ -1304,7 +1305,7 @@ first one."
                    (integer :tag "Extension"))
     :initform nil)
    (actions
-    :initform '(ebdb-field-phone-dial)))
+    :initform '(("Dial phone number" . ebdb-field-phone-dial))))
   :human-readable "phone")
 
 (cl-defmethod ebdb-string ((phone ebdb-field-phone))
@@ -1482,7 +1483,8 @@ first one."
     :initform gregorian
     :documentation "The calendar to which this date applies.")
    (actions
-    :initform '(ebdb-field-anniversary-browse)))
+    :initform '(("Browse date in calendar" . ebdb-field-anniversary-calendar)
+               ("Browse date in Org agenda" . ebdb-field-anniversary-agenda))))
   :human-readable "anniversary")
 
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-anniversary)) &optional 
slots obj)
@@ -1565,7 +1567,9 @@ first one."
     :custom string
     :initform ""
     :documentation "The label on the \"other side\" of the
-    relation, pointing at this record."))
+    relation, pointing at this record.")
+   (actions
+    :initform '(("Follow relationship" . ebdb-follow-related))))
   :human-readable "relationship")
 
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-relation)) &optional 
slots obj)
@@ -1625,7 +1629,7 @@ first one."
     :custom string
     :initform "")
    (actions
-    :initform '(ebdb-field-url-browse)))
+    :initform '(("Browse URL" . ebdb-field-url-browse))))
   :human-readable "URL")
 
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-url)) &optional slots obj)
@@ -2069,10 +2073,16 @@ or actual image data."
                                     (field ebdb-field-url))
   (browse-url (slot-value field 'url)))
 
-(cl-defmethod ebdb-field-anniversary-browse ((_record ebdb-record)
-                                            (_field ebdb-field-anniversary))
-  (require 'calendar)
-  (message "This isn't done yet."))
+(cl-defmethod ebdb-field-anniversary-calendar ((_record ebdb-record)
+                                              (field ebdb-field-anniversary))
+  (calendar)
+  (calendar-goto-date
+   (calendar-gregorian-from-absolute
+    (slot-value field 'date))))
+
+(cl-defmethod ebdb-field-anniversary-agenda ((_record ebdb-record)
+                                            (field ebdb-field-anniversary))
+  (org-agenda-list nil (slot-value field 'date)))
 
 (cl-defmethod ebdb-field-anniv-diary-entry ((anniv ebdb-field-anniversary)
                                            (record ebdb-record))