cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-refile-misc.el

   1 ;;; mew-refile-misc.el -- more mew-refile-guess-* functions
   2
   3 ;;; Written by: Sen Nagata <sen@eccosys.com>
   4 ;;;
   5
   6 ;; Keywords: refile, mew
   7 ;; Version: 0.2
   8
   9 ;;; Commentary:
  10 ;;
  11 ;; installation:
  12 ;;
  13 ;;   -put this file in an appropriate directory so emacs can find it
  14 ;;
  15 ;;   -put:
  16 ;;
  17 ;;     (add-hook 'mew-init-hook (lambda () (require 'mew-refile-misc)))
  18 ;;
  19 ;;    in .emacs (or wherever you place your mew settings)
  20 ;;
  21 ;;   -modify the value of mew-refile-guess-control to use any combination of:
  22 ;;
  23 ;;    `mew-refile-guess-by-ml-headers'
  24 ;;    `mew-refile-guess-by-x-ml-name'
  25 ;;    `mew-refile-guess-by-mailing-list'
  26 ;;    `mew-refile-guess-by-x-mailing-list'
  27 ;;
  28 ;; questions:
  29 ;;
  30 ;;   -does mew provide any functions to extract addresses from header
  31 ;;    values?  there is `mew-header-parse-address-list2', but it drops
  32 ;;    'anonymous' addresses...looks like `mew-header-parse-address'
  33 ;;    may be what i am looking for :-)
  34 ;;
  35 ;; notes:
  36 ;;
  37 ;;   -'C-uo' is great!
  38
  39 ;;; History:
  40 ;;
  41 ;; 0.2:
  42 ;;
  43 ;;  wrote `mew-refile-guess-by-ml-headers'
  44 ;;
  45 ;; 0.1:
  46 ;;
  47 ;;  initial implementation
  48
  49 ;;; Code:
  50 (defconst mew-refile-misc-version "mew-refile-misc.el 0.2")
  51
  52 ;; actually need:
  53 ;;
  54 ;;   mew-func.el (for `mew-assoc-case-equal')
  55 ;;   mew-header.el (for `mew-header-get-value')
  56 ;;
  57 ;; will this work?
  58 (eval-when-compile
  59   (require 'mew))
  60
  61 ;;
  62 ;; by ml-headers returns: guess1 or nil
  63 ;;
  64 (defun mew-refile-guess-by-ml-headers ()
  65   ;; yes, this is complicated -- i thought it was better to have something
  66   ;; than nothing even though i don't really like this way of doing things
  67   (let (
  68         list-id mailing-list x-mailing-list x-ml-name
  69         headers-list ent ret
  70         )
  71
  72     ;; 'List-Id' is used in mailman
  73     ;; List-Id: Mailman mailing list management users <mailman-users.python.org>
  74     (if (setq list-id (mew-header-get-value "List-Id:"))
  75         (progn
  76           (string-match "<\\([^>.]+\\)\\.[^>]+>$" list-id)
  77           (setq headers-list
  78                 (cons (match-string 1 list-id)
  79                       headers-list))))
  80
  81     ;; 'Mailing-List' is used by ezmlm
  82     ;; Mailing-List: contact freshmeat-news-help@freshmeat.net; run by ezmlm
  83     (if (setq mailing-list (mew-header-get-value "Mailing-List:"))
  84         (progn
  85           (string-match "\\([^ ]+\\)-help\\(@[^;]+\\);" mailing-list)
  86           (setq headers-list
  87                 (cons (match-string 1 mailing-list)
  88                       headers-list))))
  89
  90     ;; 'X-Mailing-List' is used by smartlist
  91     ;; X-Mailing-List: <debian-devel@lists.debian.org> archive/latest/42880
  92     (if (setq x-mailing-list (mew-header-get-value "X-Mailing-List:"))
  93         (progn
  94           (string-match "^<\\([^@]+\\)@[^>]+>" x-mailing-list)
  95           ;;(string-match "^ *<\\([^@]+\\)@[^>]+>" x-mailing-list)
  96           (setq headers-list
  97                 (cons (match-string 1 x-mailing-list)
  98                       headers-list))))
  99
 100     ;; 'X-ML-Name' is used by fml -- too bad this isn't helpful all the time
 101     ;; X-ML-Name: Mew-dist
 102     ;; X-ML-Name: Wanderlust
 103     (if (setq x-ml-name (mew-header-get-value "X-ML-Name:"))
 104         (progn
 105           (string-match "^\\([a-zA-Z0-9_-]+\\)$" x-ml-name)
 106           (setq headers-list
 107                 (cons (match-string 1 x-ml-name)
 108                       headers-list))))
 109
 110     ;; for the moment, use only the first guess if any
 111     (if headers-list
 112         (progn
 113           (setq ent
 114                 (mew-assoc-case-equal (car headers-list) mew-folder-alist 1))
 115           (if ent (setq ret (cons (nth 0 ent) ret)))))
 116     ret))
 117
 118 ;;
 119 ;; by x-ml-name returns: guess1 or nil
 120 ;;
 121 ;; based on `mew-refile-guess-by-folder'
 122 (defun mew-refile-guess-by-x-ml-name ()
 123   ;; typical examples:
 124   ;; X-ML-Name: Mew-dist
 125   ;; X-ML-Name: tm(ja) / tm ML ...
 126   ;; X-ML-Name: Wanderlust
 127   ;;
 128   ;; perhaps an alist of X-ML-Name: values to folder names would be useful?
 129   (let ((x-ml-name (mew-header-get-value "X-ML-Name:"))
 130         ent ret)
 131     (if x-ml-name
 132         (progn
 133           (setq ent (mew-assoc-case-equal x-ml-name mew-folder-alist 1))
 134           (if ent (setq ret (cons (nth 0 ent) ret)))))
 135     ret))
 136
 137 ;;
 138 ;; by mailing-list returns: guess1 or nil
 139 ;;
 140 ;; based on `mew-refile-guess-by-folder'
 141 (defun mew-refile-guess-by-mailing-list ()
 142   ;; typical example:
 143   ;; Mailing-List: contact freshmeat-news-help@freshmeat.net; run by ezmlm
 144   ;;
 145   ;; should try to extract address and then guess an address from the result
 146   (let ((mailing-list (mew-header-get-value "Mailing-List:"))
 147         ent ret ml-name)
 148     (if mailing-list
 149         (progn
 150           (string-match "\\([^ ]+\\)-help\\(@[^;]+\\);" mailing-list)
 151           (setq ml-name (mew-addrstr-extract-user
 152                          (concat (match-string 1 mailing-list)
 153                                  (match-string 2 mailing-list))))
 154           (setq ent (mew-assoc-case-equal ml-name mew-folder-alist 1))
 155           (if ent (setq ret (cons (nth 0 ent) ret)))))
 156     ret))
 157
 158 ;;
 159 ;; by x-mailing-list returns: (guess1 guess2 ...) or nil
 160 ;;
 161 (defun mew-refile-guess-by-x-mailing-list ()
 162   ;; typical example:
 163   ;; X-Mailing-List: <debian-devel@lists.debian.org> archive/latest/42880
 164   ;;
 165   ;; what a hack...
 166   (let ((temp-list mew-refile-guess-key-list)
 167         results)
 168     (setq mew-refile-guess-key-list '("X-Mailing-List:"))
 169     (setq results (mew-refile-guess-by-folder))
 170     (setq mew-refile-guess-key-list temp-list)
 171     results))
 172
 173 (provide 'mew-refile-misc)
 174
 175 ;;; mew-refile-misc.el ends here
 176
 177
 178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 179
 180 ;;; testing
 181
 182 ; (setq mew-refile-guess-control
 183 ;       '(
 184 ;         mew-refile-guess-by-ml-headers
 185 ;         mew-refile-ctrl-throw
 186 ;         mew-refile-guess-by-x-ml-name
 187 ;         mew-refile-guess-by-mailing-list
 188 ; ; the following one can be done by adding "X-Mailing-List:" to
 189 ; ; mew-refile-guess-key-list -- but, it may be useful to do this on its
 190 ; ; own...
 191 ;         mew-refile-guess-by-x-mailing-list
 192 ;         mew-refile-ctrl-throw
 193 ;       mew-refile-guess-by-alist
 194 ;       mew-refile-guess-by-newsgroups
 195 ;       mew-refile-guess-by-folder
 196 ;       mew-refile-ctrl-throw
 197 ;       mew-refile-ctrl-auto-boundary
 198 ;       ;; deprecated as of 1.94
 199 ;       ;mew-refile-guess-by-msgid
 200 ;       ;; new from 1.94
 201 ;       mew-refile-guess-by-thread
 202 ;       ;; new from 1.94
 203 ;       mew-refile-guess-by-from-folder
 204 ;       mew-refile-guess-by-from
 205 ;       mew-refile-guess-by-default
 206 ;       ))