[elpa] externals/debbugs b8c84dbe4b: Improve needed advice

[Michael Albinus]

branch: externals/debbugs
commit b8c84dbe4b49651b1fe74cb34ca11deb877395da
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Improve needed advice
    
    * debbugs-compat.el (debbugs-compat-url-http-attempt-keepalives):
    New defvar.
    (debbugs-compat-add-debbugs-advice)
    (debbugs-compat-remove-debbugs-advice): New defuns.
    
    * debbugs.el ( debbugs-compat): Require.
    (debbugs-soap-invoke): New defun.
    (debbugs-soap-invoke-async): Adapt for advice.
    (debbugs-get-bugs, debbugs-newest-bugs, debbugs-get-usertag)
    (debbugs-get-bug-log, debbugs-search-est): Use `debbugs-soap-invoke'
    instead of `soap-invoke'.
    (debbugs-get-status): Use `delq' instead of `delete'.
---
 debbugs-compat.el | 25 ++++++++++++++++++++-----
 debbugs.el        | 33 +++++++++++++++++++++++----------
 2 files changed, 43 insertions(+), 15 deletions(-)

diff --git a/debbugs-compat.el b/debbugs-compat.el
index 49de171584..c73110f2aa 100644
--- a/debbugs-compat.el
+++ b/debbugs-compat.el
@@ -37,14 +37,29 @@
         (replace-regexp-in-string
          (regexp-quote from-string) to-string in-string t t)))))
 
+;; This is needed for Bug#73199.
 ;; `soap-invoke-internal' let-binds `url-http-attempt-keepalives' to
 ;; t, which is not thread-safe.  We override this setting.
 (defvar url-http-attempt-keepalives)
-(advice-add
- 'url-http-create-request :around
- (lambda (orig-fun)
-   (with-no-warnings (setq url-http-attempt-keepalives nil))
-   (funcall orig-fun)))
+(defvar debbugs-compat-url-http-attempt-keepalives nil
+  "Temporary storage for `'.")
+(defun debbugs-compat-add-debbugs-advice ()
+  (with-no-warnings
+    (setq debbugs-compat-url-http-attempt-keepalives
+          url-http-attempt-keepalives))
+  (advice-add
+   'url-http-create-request :around
+   (lambda (orig-fun)
+     "Set `url-http-attempt-keepalives' to nil."
+     (with-no-warnings (setq url-http-attempt-keepalives nil))
+     (funcall orig-fun))
+   '(name debbugs-advice)))
+
+(defun debbugs-compat-remove-debbugs-advice ()
+  (advice-remove 'url-http-create-request 'debbugs-advice)
+  (with-no-warnings
+    (setq url-http-attempt-keepalives
+          debbugs-compat-url-http-attempt-keepalives)))
 
 (provide 'debbugs-compat)
 
diff --git a/debbugs.el b/debbugs.el
index 514b28b2b2..876443e270 100644
--- a/debbugs.el
+++ b/debbugs.el
@@ -38,6 +38,7 @@
 
 ;;; Code:
 
+(require 'debbugs-compat)
 (require 'subr-x)
 ;(setq soap-debug t url-debug t message-log-max t)
 (require 'soap-client)
@@ -117,18 +118,27 @@ t or 0 disables caching, nil disables expiring."
                 (const :tag "Forever" nil)
                 (integer :tag "Seconds")))
 
+(defun debbugs-soap-invoke (operation-name &rest parameters)
+  "Invoke the SOAP connection.
+OPERATION-NAME and PARAMETERS are as described in `soap-invoke'."
+  (debbugs-compat-add-debbugs-advice)
+  (prog1
+      (apply #'soap-invoke operation-name parameters)
+    (debbugs-compat-remove-debbugs-advice)))
+
 (defvar debbugs-soap-invoke-async-object nil
   "The object manipulated by `debbugs-soap-invoke-async'.")
 
 (defun debbugs-soap-invoke-async (operation-name &rest parameters)
   "Invoke the SOAP connection asynchronously.
-
 OPERATION-NAME and PARAMETERS are as described in `soap-invoke'."
+  (debbugs-compat-add-debbugs-advice)
   (apply
    #'soap-invoke-async
    (lambda (response &rest _args)
      (setq debbugs-soap-invoke-async-object
-          (append debbugs-soap-invoke-async-object (car response))))
+          (append debbugs-soap-invoke-async-object (car response)))
+     (debbugs-compat-remove-debbugs-advice))
    nil debbugs-wsdl debbugs-port operation-name parameters))
 
 (defcustom debbugs-show-progress t
@@ -304,7 +314,8 @@ patch:
     (unless (null query)
       (error "Unknown key: %s" (car query)))
     (prog1
-       (sort (car (soap-invoke debbugs-wsdl debbugs-port "get_bugs" vec)) #'<)
+       (sort (car (debbugs-soap-invoke
+                    debbugs-wsdl debbugs-port "get_bugs" vec)) #'<)
       (when debbugs-show-progress
        (remove-function
         (symbol-function debbugs-url-display-message-or-percentage-function)
@@ -340,7 +351,7 @@ patch:
            (cons 'cache_time (float-time))
            (cons 'newest_bug
                  (caar
-                  (soap-invoke
+                  (debbugs-soap-invoke
                    debbugs-wsdl debbugs-port "newest_bugs" amount)))))
 
          ;; Cache it.
@@ -351,7 +362,8 @@ patch:
        (list (alist-get 'newest_bug status)))
 
     (sort
-     (car (soap-invoke debbugs-wsdl debbugs-port "newest_bugs" amount)) #'<)))
+     (car (debbugs-soap-invoke
+           debbugs-wsdl debbugs-port "newest_bugs" amount)) #'<)))
 
 (defun debbugs-convert-soap-value-to-string (string-value)
   "If STRING-VALUE is unibyte, decode its contents as a UTF-8 string.
@@ -461,8 +473,7 @@ Example:
     ;; Check for cached bugs.
     (setq bug-numbers (delete-dups bug-numbers)
          bug-numbers
-         (delete
-          nil
+         (delq nil
           (mapcar
            (lambda (bug)
              (let ((status (gethash bug debbugs-cache-data)))
@@ -645,7 +656,8 @@ Example:
 
     (setq
      object
-     (car (soap-invoke debbugs-wsdl debbugs-port "get_usertag" (car user))))
+     (car (debbugs-soap-invoke
+           debbugs-wsdl debbugs-port "get_usertag" (car user))))
 
     (if (null tags)
        ;; Return the list of existing tags.
@@ -672,7 +684,7 @@ Every message is an association list with the following 
attributes:
 
   `attachments' A list of possible attachments, or nil.  Not
   implemented yet server side."
-  (car (soap-invoke debbugs-wsdl debbugs-port "get_bug_log" bug-number)))
+  (car (debbugs-soap-invoke debbugs-wsdl debbugs-port "get_bug_log" 
bug-number)))
 
 (defun debbugs-search-est (&rest query)
   "Return the result of a full text search according to QUERY.
@@ -957,7 +969,8 @@ Examples:
          (setq args (vconcat args (list vec)))))
 
       (setq result
-           (car (soap-invoke debbugs-wsdl debbugs-port "search_est" args)))
+           (car (debbugs-soap-invoke
+                  debbugs-wsdl debbugs-port "search_est" args)))
       ;; The result contains lists (key value).  We transform it into
       ;; cons cells (key . value).
       (dolist (elt1 result)