[elpa] externals/ebdb c212316 014/350: First commit of buffer improvements

[Eric Abrahamsen]

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

    First commit of buffer improvements
    
    The only thing wrong with this (I hope), is that the catch-all default
    implementation of `ebdb-make-buffer-name' still doesn't work -- the
    specializer definition is wrong.
---
 ebdb-com.el     | 101 ++++++++++++++++++++++++++++++++++++--------------------
 ebdb-gnus.el    |  21 +++++++++---
 ebdb-message.el |  14 ++++++--
 ebdb-mhe.el     |  25 ++++++++++----
 ebdb-mu4e.el    |   6 +++-
 ebdb-vm.el      |  33 +++++++++++++-----
 ebdb.el         |  14 --------
 7 files changed, 141 insertions(+), 73 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index ff5c3a3..f4c2cf9 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."
@@ -171,15 +162,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'.")
@@ -193,7 +187,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)))
 
@@ -638,8 +632,25 @@ 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 fed to `with-current-buffer', so it's
+acceptable to return either a buffer object, or a buffer name.")
+
+(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))
+
+(cl-defmethod ebdb-make-buffer-name (&context (major-mode _other))
+  "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.
@@ -655,24 +666,21 @@ 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)))
-
-  (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*
+  ;; 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 buf))
+
+    ;; This is all a huge hack until someone tells me how to override
+    ;; `cl-no-applicable-method'.
+    (unless target-buffer
+      (condition-case nil
+         (setq target-buffer (ebdb-make-buffer-name))
+       (cl-no-applicable-method
+        (setq target-buffer (format "*%s*" ebdb-buffer-name)))))
+
+    (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
@@ -689,8 +697,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..."))
@@ -901,9 +909,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
@@ -1269,6 +1277,27 @@ With prefix N move backwards N (sub)fields."
      (ebdb-toggle-record-mark rec 'mark))
    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 nil 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 58f7d21..e1d479d 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -3751,20 +3751,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.