[elpa] externals/ebdb 29bf304 101/350: Rework MUA window popups

[Eric Abrahamsen]

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

    Rework MUA window popups
    
    Fixes #14
    
    Refactoring still required.
    
    * ebdb-mua.el (ebdb-popup-window): Replace `ebdb-mua-window-p' with
      this, a generic function in MUA packages that returns the window to
      be split, and how to split it.
    * ebdb-com.el (ebdb-pop-up-window): Rework function to accept value of
      `ebdb-popup-window'.
    * ebdb-gnus.el: Implement `ebdb-popup-window'.
    * ebdb-message.el: Implement `ebdb-popup-window' (and fix some very
      embarrassing mistakes).
---
 ebdb-com.el     | 144 ++++++++++++++++++++------------------------------------
 ebdb-gnus.el    |  11 +++++
 ebdb-message.el |  27 ++++++-----
 ebdb-mua.el     |  44 ++++++++++-------
 4 files changed, 106 insertions(+), 120 deletions(-)

diff --git a/ebdb-com.el b/ebdb-com.el
index 1c35f3b..db8c2ed 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -668,14 +668,13 @@ buffer."
   (format "*%s*" ebdb-buffer-name))
 
 (defun ebdb-display-records (records &optional fmt append
-                                     select horiz-p buf)
+                                     select pop 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'.  BUF indicates which *EBDB* buffer to use,
-or nil to generate a buffer name based on the current major
-mode."
+SELECT and POP 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."
 
   ;; All functions that call `ebdb-display-records' set the "fmt"
   ;; argument, but that's not guaranteed.
@@ -719,7 +718,7 @@ mode."
         (message "Formatting EBDB...done."))
       (set-buffer-modified-p nil)
 
-      (ebdb-pop-up-window select horiz-p)
+      (ebdb-pop-up-window target-buffer select pop)
       (goto-char (point-min))
       (set-window-start (get-buffer-window (current-buffer)) (point)))))
 
@@ -966,91 +965,50 @@ displayed records."
     map)
   "Keymap used by `ebdb-completing-read-mails'.")
 
-;;; window configuration hackery
-(defun ebdb-pop-up-window (&optional select horiz-p)
-  "Display *EBDB* buffer by popping up a new window.
-Finds the largest window on the screen, splits it, displaying the
-*EBDB* buffer in the bottom `ebdb-pop-up-window-size' lines (unless
-the *EBDB* buffer is already visible, in which case do nothing.)
-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 (current-buffer)))
-    (cond ((let ((window (get-buffer-window buffer t)))
-             ;; We already have a EBDB window so that at most we select it
-             (and window
-                  (or (not select) (select-window window)))))
-
-          ;; try horizontal split
-          ((and horiz-p
-                (>= (frame-width) (car ebdb-horiz-pop-up-window-size))
-                (let ((window-list (window-list))
-                      (b-width (cdr ebdb-horiz-pop-up-window-size))
-                      (search t) s-window)
-                  (while (and (setq s-window (pop window-list))
-                              (setq search (not (funcall horiz-p s-window)))))
-                  (unless (or search (<= (window-width s-window)
-                                         (car ebdb-horiz-pop-up-window-size)))
-                    (condition-case nil ; `split-window' might fail
-                        (let ((window (split-window
-                                       s-window
-                                       (if (integerp b-width)
-                                           (- (window-width s-window) b-width)
-                                         (round (* (- 1 b-width) (window-width 
s-window))))
-                                       t))) ; horizontal split
-                          (set-window-buffer window buffer)
-                          (cond (ebdb-dedicated-window
-                                 (set-window-dedicated-p window 
ebdb-dedicated-window))
-                                ((fboundp 'display-buffer-record-window) ; GNU 
Emacs >= 24.1
-                                 (set-window-prev-buffers window nil)
-                                 (display-buffer-record-window 'window window 
buffer)))
-                          (if select (select-window window))
-                          t)
-                      (error nil))))))
-
-          ((eq t ebdb-pop-up-window-size)
-           (ebdb-pop-up-window-simple buffer select))
-
-          (t ;; vertical split
-           (let* ((window (selected-window))
-                  (window-height (window-height window)))
-             ;; find the tallest window...
-             (mapc (lambda (w)
-                     (let ((w-height (window-height w)))
-                       (if (> w-height window-height)
-                           (setq window w window-height w-height))))
-                   (window-list))
-             (condition-case nil
-                 (progn
-                   (unless (eql ebdb-pop-up-window-size 1.0)
-                     (setq window (split-window ; might fail
-                                   window
-                                   (if (integerp ebdb-pop-up-window-size)
-                                       (- window-height 1 ; for mode line
-                                          (max window-min-height 
ebdb-pop-up-window-size))
-                                     (round (* (- 1 ebdb-pop-up-window-size)
-                                               window-height))))))
-                   (set-window-buffer window buffer) ; might fail
-                   (cond (ebdb-dedicated-window
-                          (set-window-dedicated-p window 
ebdb-dedicated-window))
-                         ((and (fboundp 'display-buffer-record-window) ; GNU 
Emacs >= 24.1
-                               (not (eql ebdb-pop-up-window-size 1.0)))
-                          (set-window-prev-buffers window nil)
-                          (display-buffer-record-window 'window window 
buffer)))
-                   (if select (select-window window)))
-               (error (ebdb-pop-up-window-simple buffer select))))))))
-
-(defun ebdb-pop-up-window-simple (buffer select)
-  "Display BUFFER in some window, selecting it if SELECT is non-nil.
-If `ebdb-dedicated-window' is non-nil, mark the window as dedicated."
-  (let ((window (if select
-                    (progn (pop-to-buffer buffer)
-                           (get-buffer-window))
-                  (display-buffer buffer))))
-    (if ebdb-dedicated-window
-        (set-window-dedicated-p window ebdb-dedicated-window))))
+;;; This version of the function is a bit of a stop-gap, it doesn't do
+;;; everything the original did, specifically it doesn't handle
+;;; dedicated windows, and doesn't have very robust error checking.
+(defun ebdb-pop-up-window (buf &optional select pop)
+  "Display *EBDB* buffer BUF by popping up a new window.
+
+POP is typically a three-element list of (window horiz-p split),
+where WINDOW is the window to be split, HORIZ-P says whether to
+split it vertically or horizontally, and SPLIT says to split it
+by how much.  If HORIZ-P is nil, split the longest way.  If SPLIT
+is nil, split 0.5.
+
+If the whole POP argument is nil, just re-use the current
+buffer."
+  (let* ((split-window (car-safe pop))
+        (buffer-window (get-buffer-window buf t))
+        (horiz-p (or (cadr pop)
+                     (> (window-total-width split-window)
+                        (window-total-height split-window))))
+        (size (cond ((null pop)
+                     nil)
+                    ((integerp (caddr pop)))
+                    (t
+                     (let ((ratio (- 1 (or (caddr pop) 0.5)))
+                           (dimension (max (window-total-width split-window)
+                                           (window-total-height 
split-window))))
+                       (round (* dimension ratio)))))))
+
+    (cond (buffer-window
+          ;; It's already visible, re-use it.
+          (or (null select)
+              (select-window buffer-window)))
+         ((and (null split-window) (null size))
+          ;; Not splitting, but buffer isn't visible, just take up
+          ;; the whole window.
+          (set-window-buffer (selected-window) buf)
+          (setq buffer-window (get-buffer-window buf t)))
+         (t
+          ;; Otherwise split.
+          (setq buffer-window (split-window split-window size (if horiz-p 
'right 'below)))
+          (set-window-buffer buffer-window buf)))
+    (display-buffer-record-window 'window buffer-window buf)
+    (when select
+      (select-window buffer-window))))
 
 
 ;;; EBDB mode
@@ -2673,7 +2631,7 @@ If we are past `fill-column', wrap at the previous comma."
         (if ebdb-completion-display-record
             (let ((ebdb-silent-internal t))
               ;; FIXME: This pops up *EBDB* before removing *Completions*
-              (ebdb-display-records records nil t)))
+              (ebdb-display-records records nil t nil (ebdb-popup-window))))
         ;; `ebdb-complete-mail-hook' may access MAIL, ADDRESS, and RECORDS.
         (run-hooks 'ebdb-complete-mail-hook))))
 
@@ -2735,7 +2693,7 @@ of all of these people."
       (ebdb-display-records
        (delq nil
             (mapcar (lambda (u) (ebdb-gethash u 'uuid)) records))
-       nil t))))
+       nil t nil (ebdb-popup-window)))))
 
 (defun ebdb-get-mail-aliases ()
   "Return a list of mail aliases used in the EBDB."
diff --git a/ebdb-gnus.el b/ebdb-gnus.el
index 8af8e58..0d3d6ef 100644
--- a/ebdb-gnus.el
+++ b/ebdb-gnus.el
@@ -413,6 +413,17 @@ Note that `\( is the backquote, NOT the quote '\(."
   "Produce a EBDB buffer name associated with Gnus."
   (ebdb-gnus-buffer-name))
 
+(cl-defmethod ebdb-popup-window (&context (major-mode gnus-summary-mode))
+  (let ((win
+        (progn
+          (unless (gnus-buffer-live-p gnus-article-buffer)
+            (gnus-summary-show-article))
+          (get-buffer-window gnus-article-buffer))))
+    (list win nil 0.3)))
+
+(cl-defmethod ebdb-popup-window (&context (major-mode gnus-article-mode))
+  (list (get-buffer-window) nil 0.3))
+
 ;; 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
diff --git a/ebdb-message.el b/ebdb-message.el
index 4153238..150a855 100644
--- a/ebdb-message.el
+++ b/ebdb-message.el
@@ -47,18 +47,24 @@
   "Produce a EBDB buffer name associated with Mail mode."
   (format "*%s-Message*" ebdb-buffer-name))
 
-(cl-defgeneric ebdb-message-header ((header string)
+(cl-defmethod ebdb-message-header ((header string)
                                    &context (major-mode message-mode))
   (message-field-value header))
 
-(cl-defgeneric ebdb-message-header ((header string)
+(cl-defmethod ebdb-message-header ((header string)
                                    &context (major-mode notmuch-message-mode))
   (message-field-value header))
 
-(cl-defgeneric ebdb-message-header ((header string)
+(cl-defmethod ebdb-message-header ((header string)
                                    &context (major-mode mail-mode))
   (message-field-value header))
 
+(cl-defmethod ebdb-popup-window (&context (major-mode message-mode))
+  (list (get-buffer-window) nil 0.4))
+
+(cl-defmethod ebdb-popup-window (&context (major-mode mail-mode))
+  (list (get-buffer-window) nil 0.4))
+
 (defun ebdb-insinuate-message ()
   (when ebdb-complete-mail
     (cl-pushnew 
'("^\\(Resent-\\)?\\(To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
 . ebdb-complete-mail)
@@ -66,16 +72,15 @@
                :test #'equal)
     (define-key mail-mode-map (kbd "TAB") 'ebdb-complete-mail)))
 
-(defun bbdb-insinuate-mail ()
-  "Hook BBDB into Mail Mode.
-Do not call this in your init file.  Use `bbdb-initialize'."
+(defun ebdb-insinuate-mail ()
+  "Hook EBDB into Mail Mode."
   ;; Suggestions welcome: What are good keybindings for the following
   ;; commands that do not collide with existing bindings?
-  ;; (define-key mail-mode-map "'" 'bbdb-mua-display-recipients)
-  ;; (define-key mail-mode-map ";" 'bbdb-mua-edit-field-recipients)
-  ;; (define-key mail-mode-map "/" 'bbdb)
-  (if bbdb-complete-mail
-      (define-key mail-mode-map "\M-\t" 'bbdb-complete-mail)))
+  ;; (define-key mail-mode-map "'" 'ebdb-mua-display-recipients)
+  ;; (define-key mail-mode-map ";" 'ebdb-mua-edit-field-recipients)
+  ;; (define-key mail-mode-map "/" 'ebdb)
+  (if ebdb-complete-mail
+      (define-key mail-mode-map "\M-\t" 'ebdb-complete-mail)))
 
 (add-hook 'message-mode-hook 'ebdb-insinuate-message)
 (add-hook 'mail-setup-hook 'ebdb-insinuate-mail)
diff --git a/ebdb-mua.el b/ebdb-mua.el
index e4602ef..f61498d 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -1142,18 +1142,30 @@ Dispatches on the value of major-mode."
   ;; Doesn't need to do anything by default.
   t)
 
-(defun ebdb-mua-window-p ()
-  "Return lambda function matching the MUA window.
-This return value can be used as arg HORIZ-P of `ebdb-display-records'."
-  (let ((mm-alist ebdb-mua-mode-alist)
-        elt fun)
-    (while (setq elt (cdr (pop mm-alist)))
-      (if (memq major-mode elt)
-          (setq fun `(lambda (window)
-                       (with-current-buffer (window-buffer window)
-                         (memq major-mode ',elt)))
-                mm-alist nil)))
-    fun))
+(cl-defgeneric ebdb-popup-window (major-mode)
+  "Return a spec for how to pop up a window on an *EBDB* buffer.
+
+This generic function dispatches on the current value of
+major-mode.  The return value should be a three-element list
+of (window horiz-p split), in which WINDOW is the window to
+split, HORIZ-P is t if the window should be split horizontally,
+else vertically, and SPLIT is either an integer, specifying
+number of rows/columns, or a float specifying what percentage of
+window real estate the pop-up should occupy.
+
+Alternately, the return value can be nil, which means continue
+using the current window.")
+
+(cl-defmethod ebdb-popup-window (&context (major-mode ebdb-mode))
+  "When popping up from an existing *EBDB* buffer, just reuse the window.
+
+Ie, don't pop up at all."
+  nil)
+
+(cl-defmethod ebdb-popup-window ()
+  "When popping up from a random window, use half the window."
+  (let ((horiz-p (> (window-total-width) (window-total-height))))
+    (list (get-buffer-window) horiz-p 0.5)))
 
 ;;;###autoload
 (defun ebdb-mua-update-records (&optional header-class all)
@@ -1174,7 +1186,7 @@ apply, however."
     (setq records (ebdb-update-records
                   (ebdb-get-address-components header-class)
                   'query t))
-    (if records (ebdb-display-records records fmt nil nil (ebdb-mua-window-p)))
+    (if records (ebdb-display-records records fmt nil nil (ebdb-popup-window)))
     records))
 
 ;;;###autoload
@@ -1196,7 +1208,7 @@ bind `ebdb-message-all-addresses' to ALL."
     (setq records (ebdb-update-records
                   (ebdb-get-address-components header-class)
                   'existing t))
-    (if records (ebdb-display-records records fmt nil nil (ebdb-mua-window-p)))
+    (if records (ebdb-display-records records fmt nil nil (ebdb-popup-window)))
     records))
 
 ;; The following commands are some frontends for `ebdb-mua-display-records',
@@ -1323,7 +1335,7 @@ use all classes in `ebdb-message-headers'."
                  update-p))
        (ebdb-pop-up-window-size ebdb-mua-pop-up-window-size))
     (when records
-      (ebdb-display-records records nil nil nil (ebdb-mua-window-p))
+      (ebdb-display-records records nil nil nil (ebdb-popup-window))
       (dolist (record records)
        (ebdb-edit-field record field)))))
 
@@ -1379,7 +1391,7 @@ See `ebdb-mua-display-records' and friends for 
interactive commands."
     (if ebdb-mua-pop-up
        (if records
            (ebdb-display-records records ebdb-default-multiline-formatter
-                                 nil nil (ebdb-mua-window-p))
+                                 nil nil (ebdb-popup-window))
          ;; If there are no records, empty the EBDB window.
          (ebdb-undisplay-records)))
     records))