Re: Add integration to gnus-search library, if present

Eric Abrahamsen <[email protected]> Wed, 11 Nov 2020 18:14:59 -0800
Newsgroups gmane.emacs.bbdb.user
Message-ID <[email protected]> 
"Roland Winkler" <[email protected]> writes:

> On Tue Nov 10 2020 Eric Abrahamsen wrote:
>> +(defun bbdb-completion-at-point ()
> [snip]
>> +
>> +(defvar bbdb-completion-at-point-table
>> +  (completion-table-dynamic #'bbdb-completion-at-point)
>
> Did you test this? Shouldn't the arg FUNCTION of
> completion-table-dynamic be a function taking an argument?

Yes, I was being too hasty.

"Roland Winkler" <[email protected]> writes:

> On Wed Nov 11 2020 Eric Abrahamsen wrote:
>> (Just realized the function that collects strings should be
>> catching 'bbdb-hash-ok, not just testing the return value, but
>> that's a simple change.)
>
> Here I have lost track of what you are trying to achieve.
> How about you send a more complete and tested patch.

Okay, here's a complete and tested patch. You can try it out by applying
the patch and then evaluating the below, which is a simple emulation of
how an external package might make use of this completion table.

Evaluate the defun and defvar, and then eval the final sexp. You'll see
that you can type whatever you like at the prompt, but only when you've
typed "from:" and then either hit TAB directly, or given it a short
string and then hit TAB, will it complete on BBDB values.

This is an example of how completion-at-point can provide very targeted
minibuffer completion within a larger context. (This could happily
coexist with, for example, completion on file names on a different
search query key.)

(defun example-capf-function ()
  (save-excursion
    (let ((start (point)))
      (when (re-search-backward "from:" (minibuffer-prompt-end) t)
	(list (match-end 0) start
	      bbdb-completion-at-point-table)))))

(defvar example-completion-map
  (let ((km (make-sparse-keymap)))
    (set-keymap-parent km minibuffer-local-map)
    (define-key km (kbd "TAB") #'completion-at-point)
    km))

(minibuffer-with-setup-hook
    (lambda ()
      (add-hook 'completion-at-point-functions
		#'example-capf-function
		nil t))
  (read-from-minibuffer
   "Query: " nil example-completion-map))
bbdb-capf.diff (text/x-patch, 2.1 KB) 
diff --git a/lisp/bbdb-com.el b/lisp/bbdb-com.el
index a261c85..30a0727 100644
--- a/lisp/bbdb-com.el
+++ b/lisp/bbdb-com.el
@@ -2142,6 +2142,26 @@ completion with."
                            nil t)))
              (nth (1- (string-to-number result)) records))))))
 
+(defun bbdb-completion-at-point (_str)
+  "Return a list of strings for completion from the database.
+Meant to be used as a completion table in a \"completion at
+point\" context."
+  (let (strings)
+    (if (or (null bbdb-completion-list)
+	    (eq t bbdb-completion-list))
+	(setq strings (hash-table-keys bbdb-hashtable))
+      (maphash (lambda (str records)
+		 (dolist (record records)
+		   (when (catch 'bbdb-hash-ok
+			   (bbdb-hash-p str record bbdb-completion-list))
+		     (push str strings))))
+	       bbdb-hashtable))
+    strings))
+
+(defvar bbdb-completion-at-point-table
+  (completion-table-dynamic #'bbdb-completion-at-point)
+  "Completion table for use in completion-at-point functions.")
+
 ;;;###autoload
 (defun bbdb-completing-read-mails (prompt &optional init)
   "Like `read-string', but allows `bbdb-complete-mail' style completion."
@@ -2591,7 +2611,7 @@ Rebuilding the aliases is enforced if prefix FORCE-REBUILT is t."
             (bbdb-pushnew (cons alias expansion) mail-aliases)
 
             (define-mail-abbrev alias expansion)
-            
+
             (unless (setq f-alias (abbrev-symbol alias mail-abbrevs))
               (error "Cannot find the alias"))
 
diff --git a/lisp/bbdb-gnus.el b/lisp/bbdb-gnus.el
index c2ac987..b36b06f 100644
--- a/lisp/bbdb-gnus.el
+++ b/lisp/bbdb-gnus.el
@@ -48,6 +48,10 @@ Do not call this in your init file.  Use `bbdb-initialize'."
   ;; (define-key gnus-summary-mode-map "'" 'bbdb-mua-display-recipients)
   ;; (define-key gnus-summary-mode-map ";" 'bbdb-mua-edit-field-recipients)
 
+  (when (boundp 'gnus-search-contact-tables)
+    (push bbdb-completion-at-point-table
+	  gnus-search-contact-tables))
+
   ;; Set up user field for use in `gnus-summary-line-format'
   ;; (1) Big solution: use whole name
   (if bbdb-mua-summary-unify-format-letter