[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/ebdb 0912744 1/2: Allow prompt override in ebdb-read-st

From: Eric Abrahamsen
Subject: [elpa] externals/ebdb 0912744 1/2: Allow prompt override in ebdb-read-string
Date: Mon, 2 Nov 2020 15:17:13 -0500 (EST)

branch: externals/ebdb
commit 0912744df277e6efbed9f4de79983ce86372764b
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    Allow prompt override in ebdb-read-string
    Relevant to github #94, though it's not actually used anywhere yet.
    * ebdb.el (ebdb-read-string-override): New dynamic variable that can
    be bound around calls to ebdb-read-string, to augment or override the
    (ebdb-read-string): Check this variable. Also, we're now appending the
    final ": " in this call, so remove that from the prompt in all callers
    of ebdb-read-string.
 ebdb-com.el        |  8 +++---
 ebdb-gnus.el       |  2 +-
 ebdb-i18n-basic.el |  4 +--
 ebdb-mua.el        |  2 +-
 ebdb-pgp.el        |  2 +-
 ebdb.el            | 84 +++++++++++++++++++++++++++++++++---------------------
 6 files changed, 61 insertions(+), 41 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index 2f6ccd0..435b8cd 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -2515,7 +2515,7 @@ holding text to be inserted as the body of each message."
    (list (or (seq-filter (lambda (r) (nth 3 r)) ebdb-records)
             (mapcar #'car ebdb-records))
-        (ebdb-with-exit (ebdb-read-string "Subject header (C-g to skip): "))
+        (ebdb-with-exit (ebdb-read-string "Subject header (C-g to skip)"))
@@ -3110,9 +3110,9 @@ message."
-             "Number to send from (or set `ebdb-record-self'): "))
+             "Number to send from (or set `ebdb-record-self')"))
-        (ebdb-read-string "Message contents: ")
+        (ebdb-read-string "Message contents")
           (read-file-name "Attach file (C-g when done): "
@@ -3133,7 +3133,7 @@ message."
                  (list (ebdb-completing-read-record
                         (format "Add `%s' for: " url))
-                      (ebdb-read-string "URL label: "
+                      (ebdb-read-string "URL label"
                                         nil ebdb-url-label-list))))
   (let ((url-field (make-instance 'ebdb-field-url :url url :label label)))
     (ebdb-record-insert-field record url-field 'fields)
diff --git a/ebdb-gnus.el b/ebdb-gnus.el
index 7ee354c..e4972fe 100644
--- a/ebdb-gnus.el
+++ b/ebdb-gnus.el
@@ -108,7 +108,7 @@ likely ways to extract information about the record."
 (cl-defmethod ebdb-read ((field (subclass ebdb-gnus-score-field)) &optional 
slots obj)
   (let ((score (string-to-number
-                "Score: " (when obj (slot-value obj 'score))))))
+                "Score" (when obj (slot-value obj 'score))))))
     (cl-call-next-method field (plist-put slots :score score) obj)))
 (cl-defmethod ebdb-string ((field ebdb-gnus-score-field))
diff --git a/ebdb-i18n-basic.el b/ebdb-i18n-basic.el
index c0ecc78..0d57fc9 100644
--- a/ebdb-i18n-basic.el
+++ b/ebdb-i18n-basic.el
@@ -132,7 +132,7 @@ number, and any remaining as an extension."
           slots :region
           (cdr (assoc-string
-                 "State: "
+                 "State"
                  (when obj (ebdb-address-region obj))
                  ebdb-i18n-usa-states t)
@@ -226,7 +226,7 @@ number, and any remaining as an extension."
           slots :region
           (cdr (assoc-string
-                 "State: "
+                 "State"
                  (when obj (ebdb-address-region obj))
                  ebdb-i18n-india-states t)
diff --git a/ebdb-mua.el b/ebdb-mua.el
index 51a6e26..48e6a81 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -605,7 +605,7 @@ variable should be set before EBDB is loaded.")
   (unless (plist-get slots :folder)
     (setq slots (plist-put slots :folder
-                           "Folder name: "
+                           "Folder name"
                            (when obj (slot-value obj 'folder))
   (cl-call-next-method c slots obj))
diff --git a/ebdb-pgp.el b/ebdb-pgp.el
index 6d7ed9f..8b9cdf9 100644
--- a/ebdb-pgp.el
+++ b/ebdb-pgp.el
@@ -131,7 +131,7 @@ See info node `(message)security'."
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-pgp)) &optional slots obj)
   (let ((val (intern (ebdb-read-string
-                     "PGP action: " (when obj (slot-value obj 'action))
+                     "PGP action" (when obj (slot-value obj 'action))
                      ebdb-pgp-ranked-actions t))))
     (cl-call-next-method class (plist-put slots :action val) obj)))
diff --git a/ebdb.el b/ebdb.el
index 5a75221..5696ffa 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -110,6 +110,15 @@ See also `ebdb-silent'.")
 As mail field instances are created, a \"dwim\"-style string is
 added here, for use in `completion-at-point' in mail buffers.")
+(defvar ebdb-read-string-override nil
+  "An overriding prompt for `ebdb-read-string'.
+This is bound dynamically around code that will end up calling
+`ebdb-read-string'.  It can be a plain string, in which case the
+value will replace the existing prompt.  It can also be a cons
+of (STRING . POSITION), where POSITION can be one of the symbols
+`append' or `prepend', in which case STRING will be concatenated
+with the existing prompt as appropriate.")
 ;; Custom groups
 (defgroup ebdb-eieio nil
@@ -1315,7 +1324,7 @@ process."
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-user-simple)) &optional 
slots obj)
   (unless (plist-get slots :value)
     (let ((default (when obj (ebdb-string obj))))
-      (setq slots (plist-put slots :value (ebdb-read-string "Value: " 
+      (setq slots (plist-put slots :value (ebdb-read-string "Value" 
   (cl-call-next-method class slots obj))
 ;;; The name fields.  One abstract base class, and two instantiable
@@ -1364,7 +1373,7 @@ simple or complex name class."
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-name-simple))
                         &optional slots obj)
-  (let ((name (ebdb-read-string "Name: " (when obj (slot-value obj 'name)))))
+  (let ((name (ebdb-read-string "Name" (when obj (slot-value obj 'name)))))
     (cl-call-next-method class (plist-put slots :name name) obj)))
 (cl-defmethod ebdb-init-field ((name ebdb-field-name-simple) record)
@@ -1489,12 +1498,12 @@ first one."
   (if ebdb-read-name-articulate
       (let* ((surname-default (when obj (ebdb-name-last obj)))
             (given-default (when obj (ebdb-name-given obj t)))
-            (surname (read-string "Surname: " surname-default))
-            (given-names (read-string "Given name(s): " given-default)))
+            (surname (ebdb-read-string "Surname" surname-default))
+            (given-names (ebdb-read-string "Given name(s)" given-default)))
        (setq slots (plist-put slots :surname surname))
        (setq slots (plist-put slots :given-names (split-string given-names)))
        (cl-call-next-method class slots obj))
-    (ebdb-parse class (ebdb-read-string "Name: " (when obj (ebdb-string obj))) 
+    (ebdb-parse class (ebdb-read-string "Name" (when obj (ebdb-string obj))) 
 (cl-defmethod ebdb-parse ((class (subclass ebdb-field-name-complex)) str 
&optional slots)
   (pcase-let ((`(,surname ,given-names ,suffix)
@@ -1697,7 +1706,7 @@ first one."
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-mail)) &optional slots 
   (let* ((default (when obj (ebdb-string obj)))
-        (input (ebdb-read-string "Mail address: " default))
+        (input (ebdb-read-string "Mail address" default))
         (bits (ebdb-decompose-ebdb-address input))
         (mail (nth 1 bits)))
     ;; (unless (or ebdb-allow-duplicates
@@ -1803,23 +1812,23 @@ Primary sorts before normal sorts before defunct."
         (if (plist-member slots :locality)
             (plist-get slots :locality)
-          (ebdb-read-string "Town/City: "
+          (ebdb-read-string "Town/City"
                             (when obj (ebdb-address-locality obj)) 
         (if (plist-member slots :region)
             (plist-get slots :region)
-          (ebdb-read-string "State/Province: "
+          (ebdb-read-string "State/Province"
                             (when obj (ebdb-address-region obj)) 
         (if (plist-member slots :postcode)
             (plist-get slots :postcode)
-          (ebdb-read-string "Postcode: "
+          (ebdb-read-string "Postcode"
                             (when obj (ebdb-address-postcode obj))
         (if (plist-member slots :country)
             (plist-get slots :country)
-          (ebdb-read-string "Country: "
+          (ebdb-read-string "Country"
                             (if obj (slot-value obj 'country)
@@ -2024,7 +2033,7 @@ The result looks like this:
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-notes)) &optional slots 
   (let ((default (when obj (ebdb-string obj))))
     (cl-call-next-method class
-                        (plist-put slots :notes (ebdb-read-string "Notes: " 
+                        (plist-put slots :notes (ebdb-read-string "Notes" 
 (cl-defmethod ebdb-parse ((class (subclass ebdb-field-notes))
@@ -2184,7 +2193,7 @@ Eventually this method will go away."
   :human-readable "id number")
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-id)) &optional slots obj)
-  (let ((id-number (ebdb-read-string "ID number: "
+  (let ((id-number (ebdb-read-string "ID number"
                                     (when obj (slot-value obj 'id-number)))))
     (cl-call-next-method class (plist-put slots :id-number id-number) obj)))
@@ -2223,7 +2232,7 @@ Eventually this method will go away."
                  (slot-value obj 'rel-uuid)
                (ebdb-record-uuid (ebdb-prompt-for-record
                                   nil ebdb-default-record-class))))
-        (rel-label (ebdb-read-string "Reverse label (for the other record): "
+        (rel-label (ebdb-read-string "Reverse label (for the other record)"
                                      (when obj
                                        (slot-value obj 'rel-label))
@@ -2301,7 +2310,7 @@ Removes relation information from the
   :human-readable "URL")
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-url)) &optional slots obj)
-  (let ((url (ebdb-read-string "Url: " (when obj (slot-value obj 'url)))))
+  (let ((url (ebdb-read-string "Url" (when obj (slot-value obj 'url)))))
     (cl-call-next-method class (plist-put slots :url url) obj)))
 (cl-defmethod ebdb-string ((field ebdb-field-url))
@@ -2351,12 +2360,12 @@ See `ebdb-url-valid-schemes' for a list of acceptable 
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-location)) &optional
                         slots obj)
   (let ((label (or (plist-get slots :location-label)
-                  (ebdb-read-string "Location label: "
+                  (ebdb-read-string "Location label"
                                     (when obj (slot-value
                                                obj 'location-label)))))
        (geo (or (plist-get slots :location-geo)
-                 (ebdb-read-string "Location geo (C-g to skip): "
+                 (ebdb-read-string "Location geo (C-g to skip)"
                                    (when obj (slot-value
                                               obj 'location-geo))))))
        (tz (or (plist-get slots :timezone)
@@ -2403,7 +2412,7 @@ See `ebdb-url-valid-schemes' for a list of acceptable 
            ("not applicable" . na)))
         (gender (cdr
-                  (ebdb-read-string "Gender: "
+                  (ebdb-read-string "Gender"
                                     (when obj (rassoc (slot-value obj 'gender)
@@ -2492,7 +2501,7 @@ See `ebdb-url-valid-schemes' for a list of acceptable 
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-bank-account))
                         &optional slots obj)
   (let ((bank-name (or (plist-get slots :bank-name)
-                      (ebdb-read-string "Bank name: "
+                      (ebdb-read-string "Bank name"
                                         (when obj (slot-value obj 
        (bank-address (or (plist-get slots :bank-address)
@@ -2500,20 +2509,20 @@ See `ebdb-url-valid-schemes' for a list of acceptable 
                                      (when obj (slot-value obj 
        (routing-aba (or (plist-get slots :routing-aba)
-                         (ebdb-read-string "Routing or ABA number: "
+                         (ebdb-read-string "Routing or ABA number"
                                            (when obj (slot-value obj 
        (swift-bic (or (plist-get slots :swift-bic)
-                       (ebdb-read-string "SWIFT or BIC code: "
+                       (ebdb-read-string "SWIFT or BIC code"
                                          (when obj (slot-value obj 
        (account-name (or (plist-get slots :account-name)
-                         (ebdb-read-string "Account name: "
+                         (ebdb-read-string "Account name"
                                            (when obj (slot-value obj 
         (or (plist-get slots :account-numbers)
              (cons (ebdb-read-string "Account label (eg. \"checking\"): ")
-                   (ebdb-read-string "Account number/IBAN: ")))))
+                   (ebdb-read-string "Account number/IBAN")))))
        (notes (or (plist-get slots :notes)
                    (ebdb-read 'ebdb-field-notes nil
@@ -2652,7 +2661,7 @@ record uuids.")
   mail address to use with that alias.")
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-mail-alias)) &optional 
slots obj)
-  (let ((alias (ebdb-read-string "Alias: " (when obj (slot-value obj 'alias))
+  (let ((alias (ebdb-read-string "Alias" (when obj (slot-value obj 'alias))
                                 (mapcar #'car ebdb-mail-alias-alist))))
     (cl-call-next-method class (plist-put slots :alias alias) obj)))
@@ -2702,8 +2711,8 @@ record uuids.")
   :human-readable "passport")
 (cl-defmethod ebdb-read ((class (subclass ebdb-field-passport)) &optional 
slots obj)
-  (let ((country (ebdb-read-string "Country: " (when obj (slot-value obj 
-       (number (ebdb-read-string "Number: " (when obj (slot-value obj 
+  (let ((country (ebdb-read-string "Country" (when obj (slot-value obj 
+       (number (ebdb-read-string "Number" (when obj (slot-value obj 'number))))
        (issue-date (calendar-absolute-from-gregorian
        (expiration-date (calendar-absolute-from-gregorian
@@ -3471,7 +3480,7 @@ FIELD."
    (plist-put slots :domain
-             (ebdb-read-string "Domain: "
+             (ebdb-read-string "Domain"
                                (when obj (slot-value obj 'domain))))
@@ -4400,7 +4409,7 @@ prompting if there's only one database."
     (if (and shortcut (= 1 (length collection)))
        (car collection)
       (setq db-string
-           (ebdb-read-string "Choose a database: "
+           (ebdb-read-string "Choose a database"
                               (lambda (d)
@@ -4606,7 +4615,7 @@ leading \"+\"."
     (or number
        (and (null no-prompt)
-            (ebdb-read-string "Use phone number: ")))))
+            (ebdb-read-string "Use phone number")))))
 (cl-defmethod ebdb-field-phone-signal-text ((_record ebdb-record-entity)
                                            (phone-field ebdb-field-phone))
@@ -4628,7 +4637,7 @@ command's docstring for more details."
                         (and area-code
                              (number-to-string area-code))
-       (message (ebdb-read-string "Message contents: "))
+       (message (ebdb-read-string "Message contents"))
@@ -4712,9 +4721,20 @@ The inverse function of `ebdb-split'."
 (defun ebdb-read-string (prompt &optional init collection require-match)
   "Read a string, trimming whitespace and text properties.
-PROMPT is a string to prompt with.  INIT appears as initial input
-which is useful for editing existing records.  COLLECTION and
-REQUIRE-MATCH have the same meaning as in `completing-read'."
+PROMPT is a string to prompt with, and should not include a final
+\": \".  INIT appears as initial input which is useful for
+editing existing records.  COLLECTION and REQUIRE-MATCH have the
+same meaning as in `completing-read'."
+  (setq prompt
+       (concat
+        (pcase ebdb-read-string-override
+          (`,(and str (pred stringp)) str)
+          (`(,str . append)
+           (concat str " " prompt))
+          (`(,str . prepend)
+           (concat prompt " " str))
+          (_ prompt))
+        ": "))
    (if collection
        ;; Hack: In `minibuffer-local-completion-map' remove

reply via email to

[Prev in Thread] Current Thread [Next in Thread]