]> git.eshelyaron.com Git - emacs.git/commitdiff
Add reverse mapping for EUDC attribute names
authorAlexander Adolf <alexander.adolf@condition-alpha.com>
Sat, 2 Jul 2022 15:27:55 +0000 (17:27 +0200)
committerThomas Fitzsimmons <fitzsim@fitzsim.org>
Tue, 5 Jul 2022 02:05:04 +0000 (22:05 -0400)
* lisp/net/eudc.el (eudc-translate-query): new optional parameter to
reverse the mapping direction
(eudc-translate-attribute-list): new optional parameter to
reverse the mapping direction

lisp/net/eudc.el

index ca4e4c9f3770b39f3eda643c0a9fa3aca937d510..eb1342e4385175b95eedfc25c7b489d6812c92f2 100644 (file)
@@ -383,32 +383,51 @@ accordingly.  Otherwise it is set to its EUDC default binding."
            (cons protocol eudc-known-protocols))))
 
 
-(defun eudc-translate-query (query)
+(defun eudc-translate-query (query &optional reverse)
   "Translate attribute names of QUERY.
 The translation is done according to
-`eudc-protocol-attributes-translation-alist'."
+`eudc-protocol-attributes-translation-alist'.
+
+When REVERSE is nil or omitted, the attribute names are
+translated from EUDC generic names to protocol-specific
+names. When REVERSE is non-nil, the translation is from
+protocol-specific names back to EUDC generic names."
   (if eudc-protocol-attributes-translation-alist
       (mapcar (lambda (attribute)
-                (let ((trans (assq (car attribute)
-                                   (symbol-value eudc-protocol-attributes-translation-alist))))
+                (let ((trans
+                       (if reverse
+                           (rassq (car attribute)
+                                  (symbol-value eudc-protocol-attributes-translation-alist))
+                         (assq (car attribute)
+                               (symbol-value eudc-protocol-attributes-translation-alist)))))
                   (if trans
-                      (cons (cdr trans) (cdr attribute))
+                      (cons (if reverse (car trans) (cdr trans))
+                            (cdr attribute))
                     attribute)))
              query)
     query))
 
-(defun eudc-translate-attribute-list (list)
+(defun eudc-translate-attribute-list (list &optional reverse)
   "Translate a list of attribute names LIST.
 The translation is done according to
-`eudc-protocol-attributes-translation-alist'."
+`eudc-protocol-attributes-translation-alist'.
+
+When REVERSE is nil or omitted, the attribute names are
+translated from EUDC generic names to protocol-specific
+names. When REVERSE is non-nil, the translation is from
+protocol-specific names back to EUDC generic names."
   (if eudc-protocol-attributes-translation-alist
       (let (trans)
        (mapcar (lambda (attribute)
-                  (setq trans (assq attribute
-                                    (symbol-value eudc-protocol-attributes-translation-alist)))
-                  (if trans
-                      (cdr trans)
-                    attribute))
+                 (setq trans
+                        (if reverse
+                            (rassq attribute
+                                  (symbol-value eudc-protocol-attributes-translation-alist))
+                          (assq attribute
+                               (symbol-value eudc-protocol-attributes-translation-alist))))
+                 (if trans
+                     (if reverse (car trans) (cdr trans))
+                   attribute))
                list))
     list))