[elpa] externals/ebdb 9791ed5 030/350: Merge branch 'buff'

[Eric Abrahamsen]

branch: externals/ebdb
commit 9791ed5759b2c1147111dc97d844c565ce007a8b
Merge: 20785a1 9a2fd46
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Merge branch 'buff'
    
    Closes #6
---
 ebdb-com.el     | 106 +++++++++++++++++++++++++++++++++++---------------------
 ebdb-gnus.el    |  21 ++++++++---
 ebdb-message.el |  14 ++++++--
 ebdb-mhe.el     |  25 +++++++++----
 ebdb-mu4e.el    |   6 +++-
 ebdb-vm.el      |  33 +++++++++++++-----
 ebdb.el         |  14 --------
 ebdb.org        |  26 ++++++++++++++
 8 files changed, 169 insertions(+), 76 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index d23e94b..e34f7e4 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -109,15 +109,6 @@ Used by `ebdb-mouse-menu'."
   :group 'ebdb-record-display
   :type 'hook)
 
-(defcustom ebdb-multiple-buffers nil
-  "When non-nil we create a new buffer of every buffer causing pop-ups.
-You can also set this to a function returning a buffer name.
-Here a value may be the predefined function `ebdb-multiple-buffers-default'."
-  :group 'ebdb-record-display
-  :type '(choice (const :tag "Disabled" nil)
-                 (function :tag "Enabled" ebdb-multiple-buffers-default)
-                 (function :tag "User defined function")))
-
 ;; Faces for font-lock
 (defgroup ebdb-faces nil
   "Faces used by EBDB."
@@ -175,15 +166,18 @@ Here a value may be the predefined function 
`ebdb-multiple-buffers-default'."
   "Face used to display a databases's identifying character string."
   :group 'ebdb-faces)
 
-(defvar ebdb-buffer-name "*EBDB*" "Name of the EBDB buffer.")
+(defvar ebdb-buffer-name "EBDB"
+  "Default name of the EBDB buffer, without surrounding asterisks.")
+
+(defvar-local ebdb-this-buffer-name nil
+  "Buffer-local var holding the name of this particular EBDB buffer.")
 
 ;;; Buffer-local variables for the database.
-(defvar ebdb-records nil
+(defvar-local ebdb-records nil
   "EBDB records list.
 
 In the *EBDB* buffers it includes the records that are actually displayed
 and its elements are (RECORD DISPLAY-FORMAT MARKER-POS MARK).")
-(make-variable-buffer-local 'ebdb-records)
 
 (defvar ebdb-append-display nil
   "Controls the behavior of the command `ebdb-append-display'.")
@@ -197,7 +191,7 @@ INVERT-M is the mode line info if `ebdb-search-invert' is 
non-nil.")
 (defun ebdb-get-records (prompt)
   "If inside the *EBDB* buffer get the current records.
 In other buffers ask the user."
-  (if (string= ebdb-buffer-name (buffer-name))
+  (if (eql major-mode 'ebdb-mode)
       (ebdb-do-records)
     (ebdb-completing-read-records prompt)))
 
@@ -325,7 +319,9 @@ With ARG a negative number do not append."
     (define-key km (kbd "u")          'ebdb-browse-url)
     ;; (define-key km (kbd "P"       'ebdb-print)
     (define-key km (kbd "=")          'delete-other-windows)
-
+    ;; Buffer manipulation
+    (define-key km (kbd "b c")         'ebdb-clone-buffer)
+    (define-key km (kbd "b r")         'ebdb-rename-buffer)
     ;; Search keys
     (define-key km (kbd "/ /")         'ebdb)
     (define-key km (kbd "/ 1")         'ebdb-display-records)
@@ -650,12 +646,34 @@ This happens in addition to any pre-defined indentation 
of STRING."
      body-fields)
     (insert "\n")))
 
+(cl-defgeneric ebdb-make-buffer-name (&context (major-mode t))
+  "Return the buffer to be used by EBDB.
+
+This examines the current major mode, and makes a decision from
+there.  The result is passed to `with-current-buffer', so a
+buffer object or a buffer name are both acceptable.")
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode ebdb-mode))
+  "If we're already in a ebdb-mode buffer, continue using that
+buffer."
+  (current-buffer))
+
+;; Apparently this is the only way to make a catch-all method with
+;; &context.
+(cl-defmethod ebdb-make-buffer-name ()
+  "If we're in a totally unrelated buffer, use the value of
+  `ebdb-buffer-name'."
+  (format "*%s*" ebdb-buffer-name))
+
 (defun ebdb-display-records (records &optional fmt append
-                                     select horiz-p)
+                                     select horiz-p buf)
   "Display RECORDS using FMT.
-If APPEND is non-nil append RECORDS to the already displayed records.
-Otherwise RECORDS overwrite the displayed records.
-SELECT and HORIZ-P have the same meaning as in `ebdb-pop-up-window'."
+If APPEND is non-nil append RECORDS to the already displayed
+records.  Otherwise RECORDS overwrite the displayed records.
+SELECT and HORIZ-P have the same meaning as in
+`ebdb-pop-up-window'.  BUF indicates which *EBDB* buffer to use,
+or nil to generate a buffer name based on the current major
+mode."
   (interactive (list (ebdb-completing-read-records "Display records: ")
                      (ebdb-formatter-prefix)))
   (if (ebdb-append-display-p) (setq append t))
@@ -667,24 +685,13 @@ SELECT and HORIZ-P have the same meaning as in 
`ebdb-pop-up-window'."
     (setq records (mapcar (lambda (record)
                             (list record fmt (make-marker) nil))
                           records)))
+  ;; First new record.
+  (let ((first-new (caar records))
+       ;; `ebdb-make-buffer-name' is a generic function that
+       ;; dispatches on the current major mode.
+       (target-buffer (or buf (ebdb-make-buffer-name))))
 
-  (let ((first-new (caar records))     ; first new record
-        new-name)
-
-    ;; If `ebdb-multiple-buffers' is non-nil we create a new EBDB buffer
-    ;; when not already within one.  The new buffer name starts with a space,
-    ;; i.e. it does not clutter the buffer list.
-    (when (and ebdb-multiple-buffers
-               (not (assq 'ebdb-buffer-name (buffer-local-variables))))
-      (setq new-name (concat " *EBDB " (if (functionp ebdb-multiple-buffers)
-                                           (funcall ebdb-multiple-buffers)
-                                         (buffer-name))
-                            "*"))
-      ;; `ebdb-buffer-name' becomes buffer-local in the current buffer
-      ;; as well as in the buffer `ebdb-buffer-name'
-      (set (make-local-variable 'ebdb-buffer-name) new-name))
-
-    (with-current-buffer (get-buffer-create ebdb-buffer-name) ; *EBDB*
+    (with-current-buffer (get-buffer-create target-buffer)
       ;; If we are appending RECORDS to the ones already displayed,
       ;; then first remove any duplicates, and then sort them.
       (if append
@@ -701,8 +708,8 @@ SELECT and HORIZ-P have the same meaning as in 
`ebdb-pop-up-window'."
       ;; in the *EBDB* buffer.  It is intentionally not permanent-local.
       ;; A value of nil indicates that we need to (re)process the records.
       (setq ebdb-records records)
-      (if new-name
-          (set (make-local-variable 'ebdb-buffer-name) new-name))
+      ;; The following might not be needed anymore?
+      (set (make-local-variable 'ebdb-this-buffer-name) (buffer-name 
(current-buffer)))
 
       (unless (or ebdb-silent-internal ebdb-silent)
         (message "Formatting EBDB..."))
@@ -913,9 +920,9 @@ Select this window if SELECT is non-nil.
 If `ebdb-mua-pop-up' is 'horiz, and the first window matching
 the predicate HORIZ-P is wider than the car of `ebdb-horiz-pop-up-window-size'
 then the window will be split horizontally rather than vertically."
-  (let ((buffer (get-buffer ebdb-buffer-name)))
+  (let ((buffer (get-buffer ebdb-this-buffer-name)))
     (unless buffer
-      (error "No %s buffer to display" ebdb-buffer-name))
+      (error "No EBDB buffer to display"))
     (cond ((let ((window (get-buffer-window buffer t)))
              ;; We already have a EBDB window so that at most we select it
              (and window
@@ -1291,6 +1298,27 @@ With prefix N move backwards N (sub)fields."
      (ebdb-redisplay-record (car rec)))
    ebdb-records))
 
+;; Buffer manipulation
+
+;;;###autoload
+(defun ebdb-clone-buffer (&optional arg)
+  "Make a copy of the current *EBDB* buffer, renaming it."
+  (interactive (list current-prefix-arg))
+  (let ((new-name (read-string "New buffer name: "))
+       (current-records (when (eql major-mode 'ebdb-mode) ebdb-records)))
+    (ebdb-display-records current-records nil nil t nil
+                         (generate-new-buffer-name
+                          (format "*%s-%s*" ebdb-buffer-name new-name)))))
+
+;;;###autoload
+(defun ebdb-rename-buffer (new-name)
+  "Rename current *EBDB* buffer."
+  (interactive (list (read-string "New buffer name: ")))
+  (when (eql major-mode 'ebdb-mode)
+    (rename-buffer
+     (generate-new-buffer-name
+      (format "*%s-%s*" ebdb-buffer-name new-name)))))
+
 
 ;; clean-up functions
 
diff --git a/ebdb-gnus.el b/ebdb-gnus.el
index aa4ac35..00feef1 100644
--- a/ebdb-gnus.el
+++ b/ebdb-gnus.el
@@ -400,6 +400,17 @@ Note that `\( is the backquote, NOT the quote '\(."
 
 (add-hook 'gnus-startup-hook 'ebdb-insinuate-gnus)
 
+(defsubst ebdb-gnus-buffer-name ()
+  (format "*%s-Gnus*" ebdb-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode gnus-summary-mode))
+  "Produce a EBDB buffer name associated with Gnus."
+  (ebdb-gnus-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode gnus-article-mode))
+  "Produce a EBDB buffer name associated with Gnus."
+  (ebdb-gnus-buffer-name))
+
 ;; It seems that `gnus-fetch-field' fetches decoded content of
 ;; `gnus-visible-headers', ignoring `gnus-ignored-headers'.
 ;; Here we use instead `gnus-fetch-original-field' that fetches
@@ -410,26 +421,26 @@ Note that `\( is the backquote, NOT the quote '\(."
 ;; See http://permalink.gmane.org/gmane.emacs.gnus.general/78741
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql 
gnus-summary-mode)))
+                                  &context (major-mode gnus-summary-mode))
   "Return value of HEADER for current Gnus message."
   (set-buffer gnus-article-buffer)
   (gnus-fetch-original-field header))
 
 ;; This is all a little goofy.
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql 
gnus-article-mode)))
+                                  &context (major-mode gnus-article-mode))
   (set-buffer gnus-article-buffer)
   (gnus-fetch-original-field header))
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql gnus-tree-mode)))
+                                  &context (major-mode gnus-tree-mode))
   (set-buffer gnus-article-buffer)
   (gnus-fetch-original-field header))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql 
gnus-summary-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode 
gnus-summary-mode))
   (gnus-summary-select-article))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql 
gnus-article-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode 
gnus-article-mode))
   (gnus-summary-select-article))
 
 (defun ebdb-insinuate-gnus ()
diff --git a/ebdb-message.el b/ebdb-message.el
index cb17f61..4153238 100644
--- a/ebdb-message.el
+++ b/ebdb-message.el
@@ -39,16 +39,24 @@
 ;; (define-key message-mode-map ";" 'ebdb-mua-edit-field-recipients)
 ;; (define-key message-mode-map "/" 'ebdb)
 
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode message-mode))
+  "Produce a EBDB buffer name associated with Message mode."
+  (format "*%s-Message*" ebdb-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode mail-mode))
+  "Produce a EBDB buffer name associated with Mail mode."
+  (format "*%s-Message*" ebdb-buffer-name))
+
 (cl-defgeneric ebdb-message-header ((header string)
-                                   &context (major-mode (eql message-mode)))
+                                   &context (major-mode message-mode))
   (message-field-value header))
 
 (cl-defgeneric ebdb-message-header ((header string)
-                                   &context (major-mode (eql 
notmuch-message-mode)))
+                                   &context (major-mode notmuch-message-mode))
   (message-field-value header))
 
 (cl-defgeneric ebdb-message-header ((header string)
-                                   &context (major-mode (eql mail-mode)))
+                                   &context (major-mode mail-mode))
   (message-field-value header))
 
 (defun ebdb-insinuate-message ()
diff --git a/ebdb-mhe.el b/ebdb-mhe.el
index 07d120a..8fad7cc 100644
--- a/ebdb-mhe.el
+++ b/ebdb-mhe.el
@@ -49,25 +49,38 @@ Returns the empty string if HEADER is not in the message."
              (backward-char 1)
              (buffer-substring-no-properties start (point)))))))
 
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode mhe-mode))
+  "Produce a EBDB buffer name associated with mh-hmode."
+  (format "*%s-MHE*" ebdb-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode mhe-summary-mode))
+  "Produce a EBDB buffer name associated with mh-hmode."
+  (format "*%s-MHE*" ebdb-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode mhe-folder-mode))
+  "Produce a EBDB buffer name associated with mh-hmode."
+  (format "*%s-MHE*" ebdb-buffer-name))
+
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql mhe-mode)))
+                                  &context (major-mode mhe-mode))
   (ebdb/mh-header header))
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql mhe-summary-mode)))
+                                  &context (major-mode mhe-summary-mode))
   (ebdb/mh-header header))
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql mhe-folder-mode)))
+                                  &context (major-mode mhe-folder-mode))
   (ebdb/mh-header header))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql mhe-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode mhe-mode))
   (mh-show))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql 
mhe-summary-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode mhe-summary-mode))
   (mh-show))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql 
mhe-folder-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode mhe-folder-mode))
   (mh-show))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/ebdb-mu4e.el b/ebdb-mu4e.el
index f15a8fd..206243f 100644
--- a/ebdb-mu4e.el
+++ b/ebdb-mu4e.el
@@ -30,10 +30,14 @@
 ;; Tackle `mu4e-headers-mode' later
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql mu4e-view-mode)))
+                                  &context (major-mode mu4e-view-mode))
   (set-buffer mu4e~view-buffer-name)
   (message-field-value header))
 
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode mu4e-view-mode))
+  "Produce a EBDB buffer name associated with mu4e mode."
+  (format "*%s-mu4e*" ebdb-buffer-name))
+
 (defun ebdb-insinuate-mu4e ()
   "Hook EBDB into mu4e.
 Do not call this in your init file.  Use `ebdb-initialize'."
diff --git a/ebdb-vm.el b/ebdb-vm.el
index 830549a..9b63dc5 100644
--- a/ebdb-vm.el
+++ b/ebdb-vm.el
@@ -288,32 +288,49 @@ from different senders."
 ;;; should be able to collapse all these various methods into one that
 ;;; checks `derived-mode-p'.  Check how to do that with &context.
 
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode vm-mode))
+  "Produce a EBDB buffer name associated with VM mode."
+  (format "*%s-VM*" ebdb-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode 
vm-presentation-mode))
+  "Produce a EBDB buffer name associated with VM mode."
+  (format "*%s-VM*" ebdb-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode vm-summary-mode))
+  "Produce a EBDB buffer name associated with VM mode."
+  (format "*%s-VM*" ebdb-buffer-name))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode vm-virtual-mode))
+  "Produce a EBDB buffer name associated with VM mode."
+  (format "*%s-VM*" ebdb-buffer-name))
+
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql vm-mode)))
+                                  &context (major-mode vm-mode))
   (ebdb/vm-header header))
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql vm-virtual-mode)))
+                                  &context (major-mode vm-virtual-mode))
   (ebdb/vm-header header))
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql vm-summary-mode)))
+                                  &context (major-mode vm-summary-mode))
   (ebdb/vm-header header))
 
 (cl-defmethod ebdb-message-header ((header string)
-                                  &context (major-mode (eql 
vm-presentation-mode)))
+                                  &context (major-mode vm-presentation-mode))
   (ebdb/vm-header header))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql vm-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode vm-mode))
   (vm-follow-summary-cursor))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql 
vm-virtual-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode vm-virtual-mode))
   (vm-follow-summary-cursor))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql 
vm-summary-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode vm-summary-mode))
   (vm-follow-summary-cursor))
 
-(cl-defmethod ebdb-mua-prepare-article (&context (major-mode (eql 
vm-presentation-mode)))
+(cl-defmethod ebdb-mua-prepare-article (&context (major-mode 
vm-presentation-mode))
   (vm-follow-summary-cursor))
 
 ;;;###autoload
diff --git a/ebdb.el b/ebdb.el
index 09af98f..c710d9e 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -3774,20 +3774,6 @@ The return value is the new value of LIST-VAR."
       (symbol-value list-var)
     (set list-var (cons element (symbol-value list-var)))))
 
-(defun ebdb-multiple-buffers-default ()
-  "Default function for guessing a name for new *EBDB* buffers.
-May be used as value of variable `ebdb-multiple-buffers'."
-  (save-current-buffer
-    (cond ((memq major-mode '(vm-mode vm-summary-mode vm-presentation-mode
-                                      vm-virtual-mode))
-           (vm-select-folder-buffer)
-           (buffer-name))
-          ((memq major-mode '(gnus-summary-mode gnus-group-mode))
-           (set-buffer gnus-article-buffer)
-           (buffer-name))
-          ((memq major-mode '(mail-mode vm-mail-mode message-mode))
-           "message composition"))))
-
 (defsubst ebdb-add-job (spec record string)
   "Internal function: Evaluate SPEC for RECORD and STRING.
 If SPEC is a function call it with args RECORD and STRING.  Return value.
diff --git a/ebdb.org b/ebdb.org
index 150f38b..15a5dba 100644
--- a/ebdb.org
+++ b/ebdb.org
@@ -243,3 +243,29 @@ code:
 - Variable: ebdb-mua-summary-mark-format-letter
   Format letter to use in the summary buffer format string to mark a
   record.  Defaults to "e".
+* EBDB Buffers
+:PROPERTIES:
+:ID:       877ca77a-06d6-4fbf-87ec-614d03c37e30
+:END:
+EBDB buffers inherit from special-mode, and so the usual special-mode
+keybindings apply.
+
+EBDB can create several separate buffers for displaying contacts.
+Typically, each MUA creates its own EBDB buffer, with names like
+\ast{}EBDB-Gnus\ast{}, etc.  Users can also create their own buffers
+that won't be interfered with by MUA pop-up action.  Calling the
+`ebdb' command directly will create such a "user-owned" buffer; it's
+also possible to create more by using the `ebdb-clone-buffer' and
+`ebdb-rename-buffer' commands within existing EBDB buffers.
+
+- Variable ebdb-buffer-name
+  The base string that is used to create EBDB buffers, without
+  asterisks.  Defaults to "EBDB".
+
+- "b c" ebdb-clone-buffer
+  Prompt for a buffer name, and create a new EBDB buffer displaying
+  the same records as the original buffer.
+- "b r" ebdb-rename-buffer
+  Rename the current EBDB buffer.  If this is done in a MUA pop-up
+  buffer, the original buffer will be recreated next time the MUA
+  requests another pop up.