emacs-gnus-group-mail-spliting-on-mailing-list-headers.patch 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. From 45e37537620e594f0fb77210a9163e3da246666d Mon Sep 17 00:00:00 2001
  2. From: Daniel Dehennin <daniel.dehennin@baby-gnu.org>
  3. Date: Thu, 12 Apr 2018 00:40:13 +0200
  4. Subject: [PATCH] Gnus Group Mail Spliting on mailing-list headers
  5. * texi/gnus.texi: Document the new `list' split abbreviation and
  6. `match-list' group parameter (bug#25346).
  7. * lisp/gnus-mlspl.el: Use the `list' abbreviation when the new
  8. `match-list' group parameter is set to `t'.
  9. The split regexp is modified to match either `@` or `.` as domain
  10. separator to comply with RFC2919 IDs too.
  11. * lisp/nnmail.el: Add new `list' split abbreviation matching common
  12. mailing-list headers.
  13. ---
  14. doc/misc/gnus.texi | 18 ++++++++++++++++++
  15. etc/NEWS | 5 +++++
  16. lisp/gnus/gnus-mlspl.el | 25 +++++++++++++++++++------
  17. lisp/gnus/nnmail.el | 3 ++-
  18. 4 files changed, 44 insertions(+), 7 deletions(-)
  19. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
  20. index cc4b2342be..de219c6e56 100644
  21. --- a/doc/misc/gnus.texi
  22. +++ b/doc/misc/gnus.texi
  23. @@ -3102,6 +3102,21 @@ Group Parameters
  24. The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve,
  25. Top, sieve, Emacs Sieve}.
  26. +@item match-list
  27. +@cindex match-list
  28. +If this parameter is set to @code{t} and @code{nnmail-split-method} is
  29. +set to @code{gnus-group-split}, Gnus will match @code{to-address},
  30. +@code{to-list}, @code{extra-aliases} and @code{split-regexp} against
  31. +the @code{list} split abbreviation. The split regexp is modified to
  32. +match either a @code{@@} or a dot @code{.} in mail addresses to
  33. +conform to RFC2919 @code{List-ID}.
  34. +
  35. +See @code{nnmail-split-abbrev-alist} for the regular expression
  36. +matching mailing-list headers.
  37. +
  38. +See @pxref{Group Mail Splitting} to automatically split on group
  39. +parameters.
  40. +
  41. @item (agent parameters)
  42. If the agent has been enabled, you can set any of its parameters to
  43. control the behavior of the agent in individual groups. See Agent
  44. @@ -15475,6 +15490,9 @@ Fancy Mail Splitting
  45. @item any
  46. Is the union of the @code{from} and @code{to} entries.
  47. @end table
  48. +@item list
  49. +Matches the @samp{List-ID}, @samp{List-Post}, @samp{X-Mailing-List},
  50. +@samp{X-BeenThere} and @samp{X-Loop} fields.
  51. @vindex nnmail-split-fancy-syntax-table
  52. @code{nnmail-split-fancy-syntax-table} is the syntax table in effect
  53. diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
  54. index fb45007c12..599b9c61dc 100644
  55. --- a/lisp/gnus/gnus-mlspl.el
  56. +++ b/lisp/gnus/gnus-mlspl.el
  57. @@ -182,7 +182,8 @@ gnus-group-split-fancy
  58. (to-list (cdr (assoc 'to-list params)))
  59. (extra-aliases (cdr (assoc 'extra-aliases params)))
  60. (split-regexp (cdr (assoc 'split-regexp params)))
  61. - (split-exclude (cdr (assoc 'split-exclude params))))
  62. + (split-exclude (cdr (assoc 'split-exclude params)))
  63. + (match-list (cdr (assoc 'match-list params))))
  64. (when (or to-address to-list extra-aliases split-regexp)
  65. ;; regexp-quote to-address, to-list and extra-aliases
  66. ;; and add them all to split-regexp
  67. @@ -202,16 +203,28 @@ gnus-group-split-fancy
  68. "\\|")
  69. "\\)"))
  70. ;; Now create the new SPLIT
  71. - (push (append
  72. - (list 'any split-regexp)
  73. + (let ((split-regexp-with-list-ids
  74. + (replace-regexp-in-string "@" "[@.]" split-regexp t t))
  75. + (exclude
  76. ;; Generate RESTRICTs for SPLIT-EXCLUDEs.
  77. (if (listp split-exclude)
  78. (apply #'append
  79. (mapcar (lambda (arg) (list '- arg))
  80. split-exclude))
  81. - (list '- split-exclude))
  82. - (list group-clean))
  83. - split)
  84. + (list '- split-exclude))))
  85. +
  86. + (if match-list
  87. + ;; Match RFC2919 IDs or mail addresses
  88. + (push (append
  89. + (list 'list split-regexp-with-list-ids)
  90. + exclude
  91. + (list group-clean))
  92. + split)
  93. + (push (append
  94. + (list 'any split-regexp)
  95. + exclude
  96. + (list group-clean))
  97. + split)))
  98. ;; If it matches the empty string, it is a catch-all
  99. (when (string-match split-regexp "")
  100. (setq catch-all nil)))))))))
  101. diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
  102. index b2c86d35d1..5083fa2487 100644
  103. --- a/lisp/gnus/nnmail.el
  104. +++ b/lisp/gnus/nnmail.el
  105. @@ -515,7 +515,8 @@
  106. (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
  107. (from . "from\\|sender\\|resent-from")
  108. (nato . "to\\|cc\\|resent-to\\|resent-cc")
  109. - (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
  110. + (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc")
  111. + (list . "list-id\\|list-post\\|x-mailing-list\||x-beenthere\\|x-loop"))
  112. "*Alist of abbreviations allowed in `nnmail-split-fancy'."
  113. :group 'nnmail-split
  114. :type '(repeat (cons :format "%v" symbol regexp)))
  115. --
  116. 2.17.0