[Mew-dist 14994] mew-mlm.el 0.1h (experimental release)

[sen_ml at example.com]

Mew でメーリングリストの参加や脱会情報を管理（＋α）するためのコードを
書いています。

この様な情報をとっておく事により、以下の様な事が実現しやすくなるのでは
ないかと思っています。

・任意のメーリングリストからのメッセージに対してどのメーリングリストの
  ものかを判断しやすくする

・メーリングリストの参加や脱会手順を簡単にする

・任意のメーリングリストのアーカイブを Mew の中から検索できる様にする

・その他

ある程度実現しましたので、一度リリースします。興味のある冒険者の
方は試してみて下さい。


ここから先は興味のある冒険者の方のための記述です（誰かいるかな...）

Mew-1.95b78 以降では動作するはずですが、それ以前は確認していません。
contrib の mew-browse.el も必要です。

インストール方法は、

1) mew-mlm.el を load-path 上におく

2) .emacs に

    (add-hook 'mew-init-hook
              '(lambda ()
                  (require 'mew-mlm)))

  と記す

です。

現在 interactive に試せる関数には、

  mew-mlm-add-entry-with-guess-interactively
  mew-mlm-edit-entry-interactively
  mew-mlm-delete-entry-interactively

と

  mew-mlm-unsubscribe
  mew-mlm-unsubscribe-from-this-list
  mew-mlm-post-to-this-list

があります。

前者の関数を使用してメーリングリスト一つにつき、一つのレコードを作成、編集、
削除等を行ないます。

＃ リスト情報の編集のために専用のモードを作成しようかと思っていますが、
   ちょっと先になりそうです。

後者の関数はメーリングリストの情報を登録してから使用してみて下さい。

~/Mail/ の下に .mew-mlm-master-alist というファイルができますが、これは
メーリングリストの情報を保存しておくものです。

では
-------------- next part --------------
;;; mew-mlm.el -- mailing list mgmt support

;; Author: Sen Nagata <sen at example.com>
;; Keywords: Mew, mailing list management
;; Version: 0.1h

;; Prerequisites:
;;
;;   Mew-1.95bX (X >= 78)
;;   mew-browse.el (see contrib for Mew)

;; Usage:
;;
;; 1) put this file in your load-path
;;
;; 2) put:
;;
;;    (add-hook 'mew-init-hook
;;              '(lambda ()
;;                  (require 'mew-mlm)))
;;
;;  in your .emacs.

;; Commands to try out as a user:
;;
;; `mew-mlm-add-entry-with-guess-interactively'
;; `mew-mlm-edit-entry-interactively'
;; `mew-mlm-delete-entry-interactively'
;; `mew-mlm-unsubscribe'
;; `mew-mlm-unsubscribe-from-this-list'
;; `mew-mlm-post-to-this-list'

;; NEAR-TERM TODO:
;;
;; -function to use w/ refiling -- new mew-refile-guess-by-* function
;;
;; -ok to suppose messages from a given list are usually refiled to a
;;  particular folder?  if so, any good way to guess this when refiling
;;  and remember the decided value in `mew-mlm-master-alist'?
;;  how about using a rule to calculate the refiling destination?
;;  e.g. list w/ key "x" gets refiled to +ml/x.  perhaps allow the calculated
;;  value to be overridden by a stored value.  some list-ids are long
;;  will that cause any problems (limit of 255 chars)?
;;  ponder how to deal w/ changes in name of key for list...
;;
;; -functions that can do:
;;
;;    -post to "this list"
;;    -unsusbcribe from "this list"
;;    -subscribe to "this list"
;;    -use browser to visit archive(s) of "this list"
;;    -search "this list"'s web archive(s) (local archive too?)
;;
;;  where "this list" is identified by context -- e.g. these commands
;;  are executed in summary mode (or may be message mode too?), w/ point
;;  being on a row/line associated w/ a particular message.
;;
;; -test ;-)
;;
;; MEDIUM-TERM TODO:
;;
;; -keybindings and menus
;;
;; -want a nicer user interface for manipulating the contents of
;;  mew-mlm-master-alist -- e.g. widget-based.  it seems like forms mode
;;  ought to handle lisp data structures...alternatively, create a
;;  specific mode (cf. mhc)
;;
;; -check user input for list-* fields.  e.g. don't accept strings that
;;  don't contain urls, for instance.  how about for other fields?
;;
;; -for guessing possible values for creating a new entry, consider 
;;  providing alternatives for each field using completion on seemingly 
;;  meaningful values extracted from message
;;
;; -could store filter-info as a string (i.e. like a header line)
;;
;; -store values to help construct urls to perform searches of archives.
;;  support multiple locations to search?
;;
;; -for replacement of an existing entry, consider comparing the new
;;  entry contents w/ the old entry contents.  if they are the same,
;;  there's no need to change anything.
;;
;; LONG-TERM TODO:
;;
;; -function which tries to extract ml info from help messages for
;;  various list packages.  e.g. with cursor on a help message in
;;  summary mode, execute `mew-mlm-merge-unsubscribe-info-from-message'
;;  or some such.  is it a good idea to try to merge multiple pieces of
;;  info (e.g. unsubscribe info and subscribe info)?
;;
;; -store values to point to other entries for handling lists that split,
;;  move machines, change mailing list software, etc.  note that this will
;;  require altering the functions which manipulate entries in 
;;  mew-mlm-master-alist in order to maintain integrity of "associations".
;;  e.g. when removing an entry, need to do something about all entries
;;  that "point to" the entry about to be removed.
;;
;; -fetching and importing archives
;;
;; -add relevant `mew-summary-msg' etc. macros to appropriate places
;;
;; UNKNOWN TODO:
;;
;; -rewrite code using more functions from Mew?
;;
;; -store folder to refile into?
;;
;; -providing ability to choose from various values via completion is
;;  good.  however, it would be nice to be able to indicate some kind of
;;  priority or preference among choices.  cf. items further to the left
;;  in a list are considered better choices in RFC 2369 header values.
;;
;; -list status?  defunct, alive, etc.
;;
;; -subscription status?  subscribed, unsubscribed, etc.
;;
;; -making a version of this that's usable from other mail clients in
;;  addition to mew
;;
;; -import/export functions to an external data format -- XML for
;;  non-emacs mail clients?  note: issue of exporting sensitive data:
;;  auth-info and some (un)subscription info contain user addresses and/or
;;  names
;;
;; -does it make sense to suggest that `mew-browse-url-mailto' handle
;;  urls enclosed in brackets?  probably not.  may be a new function
;;  to operate on objects near/around point.
;;
;; -for a function like `mew-mlm-unsubscribe', could decide not to show 
;;  items that don't have unsubscribe info (in completion lists for example)
;;
;; -editing of filter information.  specific mode for editing and
;;  viewing (cf. mhc) should take care of this concern?
;;
;; -provide some way of viewing contents of `mew-mlm-master-alist'.
;;  specific mode for editing and viewing (cf. mhc) should take care of 
;;  this concern?
;;
;; -function for adding entry from scratch w/o guessing.  specific mode
;;  for editting and viewing (cf. mhc) should take care of this concern?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; dependencies

(eval-when-compile 
  (require 'mew)
  (require 'mew-browse)) ; for `mew-browse-url-mailto' (see SRC/contrib)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; variable definitions

(defvar mew-mlm-master-alist nil
  "Alist for storing mailing list information.
Each key is a string identifying a single mailing list.  Each associated
value stores information for a single mailing list.

See the definition of `mew-mlm-make-entry' for structural details
of each entry.

Note that the alist is initialized from and stored in 
`mew-mlm-master-alist-file'.

Note: expect the stored data format to change a bit.")

(defvar mew-mlm-master-alist-file ".mew-mlm-master-alist"
  "File for initializing and storing `mew-mlm-master-alist'.")

(defvar mew-mlm-guess-alist nil
  "Constructed alist for storing guess information.
This alist is constructed from `mew-mlm-master-alist'.  It's integrity should 
be maintained by the code in this file.  It is not intended to altered
directly.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; secondary storage (persistence) functions

(defun mew-mlm-load-master-alist ()
  "Load `mew-mlm-master-alist' from `mew-mlm-master-alist-file'."
  (interactive)
  (setq mew-mlm-master-alist (mew-lisp-load mew-mlm-master-alist-file)))

(defun mew-mlm-save-master-alist ()
  "Save `mew-mlm-master-alist' to `mew-mlm-master-alist-file'."
  (interactive)
  (mew-lisp-save mew-mlm-master-alist-file mew-mlm-master-alist))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; constructors and selectors for entries of `mew-mlm-master-alist'

;; expect this to change (number and type of fields)
(defun mew-mlm-make-entry (key 
			  help unsubscribe subscribe post owner archive 
			  auth-info filter-info search-list parents)
  "Construct an entry from arguments.
KEY is a string to identify the entry.  One possible choice would be 
the List-Id value.  This might not be the best choice, but it's what
will be used for the moment.

HELP, UNSUBSCRIBE, SUBSCRIBE, POST, OWNER, and ARCHIVE are lists of 
strings containing angle-bracket enclosed URLs.  These arguments 
represent the corresponding List-* header values from RFC 2369.
An example value for POST is \"<mailto:mew-dist at example.com>\".

AUTH-INFO is a string.  It contains user authentication info for the
given list.  The format of the string is free-form for the moment. 
For example, it might contain a user name and password.

FILTER-INFO is a cons cell.  The car and cdr are strings representing
the mail header name (includes colon) and corresponding header value
that are used to identify which mailing list a particular message is
associated with.

SEARCH-LIST is a list.  Each element is a cons cell.  The car and cdr
are strings that are concatenated on the left and right sides of a
URL-escaped search string to form a URL (HTTP being the main use) that
when accessed should return search results.

PARENTS is a list.  Each element is a string corresponding to the key
of some other \"parent\" entry in `mew-mlm-master-alist'.  The purpose of 
this field is to provide a means of supporting associations between lists
which are historically related.  Examples of historical relations are:

  1) A list was moved from one machine to another, and the machine's 
     DNS name was changed.  Consequently, the List-Id value changes.

  2) Software used to host a list was changed.  Consequently, List-*
     information changed.

  3) List splits into two pieces.

  4) The membership from two mailing lists was merged into one list.

Note that SEARCH-LIST and PARENTS functionality is currently
unimplemented.

This is a low-level utility function intended for use by other functions."
  (cons key (list (cons "help" help)
		  (cons "unsubscribe" unsubscribe)
		  (cons "subscribe" subscribe)
		  (cons "post" post)
		  (cons "owner" owner)
		  (cons "archive" archive)
		  (cons "auth-info" auth-info)
		  (cons "filter-info" filter-info)
		  (cons "search-list" search-list)
		  (cons "parents" parents))))

;; the selectors could probably all be defined via macros -- but edebug
;; usage becomes complicated, so forget it.
(defun mew-mlm-entry:key (entry)
  (car entry))

;; TODO: rewrite selectors below in terms of this function?
(defun mew-mlm-entry-field (entry field-name)
  (cdr (assoc field-name (cdr entry))))

(defun mew-mlm-entry:help (entry)
  (cdr (assoc "help" (cdr entry))))

(defun mew-mlm-entry:unsubscribe (entry)
  (cdr (assoc "unsubscribe" (cdr entry))))

(defun mew-mlm-entry:subscribe (entry)
  (cdr (assoc "subscribe" (cdr entry))))

(defun mew-mlm-entry:post (entry)
  (cdr (assoc "post" (cdr entry))))

(defun mew-mlm-entry:owner (entry)
  (cdr (assoc "owner" (cdr entry))))

(defun mew-mlm-entry:archive (entry)
  (cdr (assoc "archive" (cdr entry))))

(defun mew-mlm-entry:auth-info (entry)
  (cdr (assoc "auth-info" (cdr entry))))

(defun mew-mlm-entry:filter-info (entry)
  (cdr (assoc "filter-info" (cdr entry))))

(defun mew-mlm-entry:search-list (entry)
  (cdr (assoc "search-list" (cdr entry))))

(defun mew-mlm-entry:parents (entry)
  (cdr (assoc "parents" (cdr entry))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; string manipulation functions

;; TODO: perhaps should return nil instead of calling error for functions
;;       in this section

;; TODO: figure out when to use `error' and when to use `message'

(defun mew-mlm-extract-abes-from-string (string)
  "Extract an abes (angle-bracket-enclosed string) from STRING."
  (if (string-match "\\(<[^>]+>\\)" string)
      (match-string 1 string)
    (error "`%s' does not appear to contain an angle-bracket-enclosed string."
	   string)))

(defun mew-mlm-strip-enclosing-angle-brackets (abes)
  "Strip enclosing angle brackets from ABES (angle-bracket-enclosed string)."
  (if (string-match "^<\\([^>]+\\)>$" abes)
      (match-string 1 abes)
    (error "`%s' does not appear to be an angle-bracket-enclosed string." 
	   abes)))

;; TODO: should work for most simple cases
(defun mew-mlm-extract-address-from-string (string)
  "Extract an email address from STRING."
  (if (string-match "<\\([^@]+@[^@]+\\)>" string)
      (match-string 1 string)
    (if (string-match "\\([^ \t@<]+@[^ \t@>]+\\)" string)
	(match-string 1 string)
      (error "`%s' does not appear to contain an address." string))))

;; TODO: quick hack -- haven't checked standards
(defun mew-mlm-make-list-id-from-address (address)
  "Convert ADDRESS into a list-id value.
ADDRESS is a simple email address (i.e. user at example.com).

Returns a list-id value on success, nil otherwise."
  (if (string-match "^\\([^@]+\\)@\\([^@]+\\)$" address)
      (concat (match-string 1 address)
	      "."
	      (match-string 2 address))
    nil))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; prompting-related functions

(defun mew-mlm-string-to-list (string)
  "Convert a comma-separated string into a list."
  (split-string string ",[ ]+"))

(defun mew-mlm-list-to-string (list)
  "Convert a list into a comma-separated list."
  (mapconcat (lambda (elt) elt) list ", "))

(defun mew-mlm-list-to-alist (list)
  "Convert LIST into an alist.
Each element of LIST becomes a key in alist.  Each value associated with
each key is nil."
  (mapcar (lambda (elt) 
	    (cons elt nil)) 
	  list))

(defun mew-mlm-prompt-for-string (prompt default)
  "Prompt user for a string value represented as a string.
PROMPT is the minibuffer prompt.  DEFAULT is a default string."
  (read-from-minibuffer prompt default))

;; TODO: consider possible "escaping commas (separators)" issue
(defun mew-mlm-prompt-for-list (prompt default-list)
  "Prompt user for a list value represented as a string.
PROMPT is the minibuffer prompt.  DEFAULT-LIST is a list of values used
to create a default string.

The string is split on commas to create multiple elements for a list.

By using commas, the user can express multiple values as a string.
Spaces are not a good choice because individual values are likely to contain
them."
  (mew-mlm-string-to-list
   (read-from-minibuffer prompt (mew-mlm-list-to-string default-list))))

;; TODO: probably ok to allow list to have only one element
(defun mew-mlm-prompt-from-list-with-default (prompt list default)
  "Prompt user for a choice from LIST.
PROMPT is used to construct the prompt.

DEFAULT is displayed and used as a default value.

Supports completion."
  (if (and (not (null list)) (listp list))
      (completing-read 
       (format (concat prompt " (%s): ") default)
       (mew-mlm-list-to-alist list) 
       nil t nil nil default)
    (error "List empty or argument not list.")))

(defun mew-mlm-prompt-for-header-line (prompt default)
  "Prompt user for a header line.
PROMPT is used as a prompt.  

DEFAULT is displayed and used as a default value.

Returns a cons cell if successful.  The car is the header name and the
cdr is the header value.

If unsuccessful at reading a proper header line, return nil.

Think of a header line as a complete header line from a mail message."
  (let* ((input
	  (read-from-minibuffer prompt default nil nil nil default))
	 name value)
    (if (string-match "\\([^:]+:\\)[ ]+\\([^ ]+.*\\)" input)
	(cons (match-string 1 input)
	      (match-string 2 input))
      nil)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; functions related to manipulating `mew-mlm-master-alist'

(defun mew-mlm-get-entry (key)
  "Retrieve entry keyed to KEY from `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
  (let ((entry (assoc key mew-mlm-master-alist)))
    (if (not entry)
	(error "There is no entry with key `%s'." key)
      entry)))

(defun mew-mlm-key-exists-p (key)
  "Check existence for entry keyed to KEY.
If entry exists, return t, otherwise return nil."
  (if (assoc key mew-mlm-master-alist)
      t
    nil))

(defun mew-mlm-delete-entry (key)
  "Delete entry keyed to KEY from `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
  (let ((entry (mew-mlm-get-entry key)))
    (if entry
	(progn
	  ;; see doc for `delq' for explanation of `setq' in following line
	  (setq mew-mlm-master-alist (delq entry mew-mlm-master-alist))
	  (setq mew-mlm-guess-alist (mew-mlm-make-guess-alist)))
      ;; redundant given the definition of `mew-mlm-get-entry'?
      (error "There is no entry with key `%s'." key))))
  
(defun mew-mlm-add-new-entry (entry)
  "Add a new entry to `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
  (if (assoc (car entry) mew-mlm-master-alist)
      (error "An entry with the key `%s' already exists." (car entry))
    (progn
      (setq mew-mlm-master-alist
	    (cons entry mew-mlm-master-alist))
      (setq mew-mlm-guess-alist (mew-mlm-make-guess-alist)))))

(defun mew-mlm-replace-entry (from-entry to-entry)
  "Replace entry FROM-ENTRY with entry TO-ENTRY in `mew-mlm-master-alist'.
This is a low-level utility function intended for use by other functions."
  ;; see doc for `delq' for explanation of `setq' in following line
  (setq mew-mlm-master-alist
	(delq from-entry mew-mlm-master-alist))
  (setq mew-mlm-master-alist
	(cons to-entry mew-mlm-master-alist))
  (setq mew-mlm-guess-alist (mew-mlm-make-guess-alist)))

;; TODO: decide whether second argument should be optional
(defun mew-mlm-copy-and-morph-entry (entry check-for-key)
  "Allow the user to create a new entry based on ENTRY.

If CHECK-FOR-KEY is t, the existence of the user-specified
key is checked for in `mew-mlm-master-alist'.

This is a helper function for `mew-mlm-add-entry-with-guess-interactively' 
and `mew-mlm-edit-entry-interactively'."
  (let ((key (mew-mlm-entry:key entry))
	(help (mew-mlm-entry:help entry))
	(unsubscribe (mew-mlm-entry:unsubscribe entry))
	(subscribe (mew-mlm-entry:subscribe entry))
	(post (mew-mlm-entry:post entry))
	(owner (mew-mlm-entry:owner entry))
	(archive (mew-mlm-entry:archive entry))
	(auth-info (mew-mlm-entry:auth-info entry))
	(filter-info (mew-mlm-entry:filter-info entry))
	(search-list (mew-mlm-entry:search-list entry))
	(parents (mew-mlm-entry:parents entry))
	key-good)

    (while (not key-good)
      (setq key
	    (mew-mlm-prompt-for-string "Key: " key))
      (if (equal key "")
	(progn
	  (message "The empty string is not allowed as a key.")
	  (sit-for 1))
	(if (and check-for-key
		 (mew-mlm-key-exists-p key))
	    (progn
	      (message "That key exists already.")
	      (sit-for 1))
	  (setq key-good t))))

    (setq help 
	  (mew-mlm-prompt-for-list "Help: " help)
	  
	  unsubscribe 
	  (mew-mlm-prompt-for-list "Unsubscribe: " unsubscribe)
	  
	  subscribe
	  (mew-mlm-prompt-for-list "Subscribe: " subscribe)
	  
	  post
	  (mew-mlm-prompt-for-list "Post: " post)
	  
	  owner
	  (mew-mlm-prompt-for-list "Owner: " owner)
	  
	  archive
	  (mew-mlm-prompt-for-list "Archive: " archive)
	  
	  auth-info
	  (read-from-minibuffer 
	   "Authentication info: " 
	   auth-info)

	  filter-info
	  (mew-mlm-prompt-for-header-line 
	   "Filter info: " 
	   (concat (car filter-info) " " (cdr filter-info))))
    
    (mew-mlm-make-entry key 
			help unsubscribe subscribe post owner archive
			auth-info filter-info search-list parents)))

(defun mew-mlm-add-entry-with-guess-interactively ()
  "Interactively add a new entry to `mew-mlm-master-alist'.

Never call this non-interactively."
  (interactive)
;  (mew-summary-msg
  (let* ((default-entry (mew-mlm-make-entry-from-message))
	 (key (mew-mlm-entry:key default-entry)))
    ;; TODO: perhaps offer choice of overwriting or changing key eventually
    (if (mew-mlm-key-exists-p key)
	;;(error "Entry with key `%s' already exists." key)
	(message "Entry with key `%s' already exists." key)
      (mew-mlm-add-new-entry 
       (mew-mlm-copy-and-morph-entry default-entry t))))
;   )
  )

(defun mew-mlm-edit-entry-interactively (key)
  "Interactively edit an existing entry keyed to KEY in `mew-mlm-master-alist'.
Supports completion on KEY.

Never call this non-interactively."
  (interactive
   (list
    (completing-read "Edit entry with key: " mew-mlm-master-alist nil t)))
  (if (not (equal key ""))
      (let* ((entry (mew-mlm-get-entry key))
	     (new-entry (mew-mlm-copy-and-morph-entry entry nil)))
	(mew-mlm-replace-entry entry new-entry))
    (message "Not editing any entry.")))

(defun mew-mlm-delete-entry-interactively (key)
  "Interactively delete entry keyed to KEY from `mew-mlm-master-alist'.
Supports completion."
  (interactive
   (list
    (completing-read "Delete entry with key: " mew-mlm-master-alist nil t)))
  (if (not (equal key ""))
      (mew-mlm-delete-entry key)
    (message "Not deleting any entry.")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; functions for manipulating `mew-mlm-guess-alist'

(defun mew-mlm-make-guess-entry (header)
  "Constructor for an entry of `mew-mlm-guess-alist'.
HEADER is a message header name (with colon)."
  (cons header nil))

(defun mew-mlm-add-value-to-guess-entry (guess-entry value)
  "Add VALUE to GUESS-ENTRY.
GUESS-ENTRY is an entry created by `mew-mlm-make-guess-entry'.

VALUE is a cons cell.  The car is a message header value.  The cdr is
a key for an entry in `mew-mlm-master-alist'."
  (setcdr guess-entry
	  (cons value (cdr guess-entry))))

;; TODO: decide policy regarding whether to allow ml-entries that
;;       have no filter-info
(defun mew-mlm-make-guess-alist ()
  "Constructor for `mew-mlm-guess-alist'.
Each key is a message header name.  Each value is an alist of elements 
representing message header values and corresponding key strings for 
entries in `mew-mlm-master-alist'.  So each element is a cons cell."
  (let (alist)
    (mapcar
     (function 
      (lambda (ml-entry)
	;; TODO: write selectors for filter-info portion of ml-entry?
	(let* ((header-name (car (mew-mlm-entry:filter-info ml-entry)))
	       (header-value (cdr (mew-mlm-entry:filter-info ml-entry)))
	       (ml-key (mew-mlm-entry:key ml-entry))
	       (guess-entry (assoc header-name alist)))
	  (if (not guess-entry)
	      ;; no guess-entry, so create a new one and add it to
	      ;; alist
	      (progn
		(setq guess-entry (mew-mlm-make-guess-entry header-name))
		(setq alist
		      (cons guess-entry alist))))
	  ;; TODO: check for duplicates before adding?
	  (mew-mlm-add-value-to-guess-entry 
	   guess-entry
	   (cons header-value ml-key)))))
     mew-mlm-master-alist)
    ;; less confusing this way
    alist))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; guessing -- some code in this section could do w/ a serious rewrite

;; some of the following are based on some functions from mew-refile.el

(defun mew-mlm-guess-list-from-message-helper ()
  "Guess the mailing list that the current message is associated with.
Returns a key for `mew-mlm-master-alist'.

This is a helper function for `mew-mlm-guess-list-from-message', and
assumes that preparations have been made for examining the current 
message (via `mew-mlm-examine-message')."
  (let* ((ml-guess (mew-mlm-guess-list-from-message-helper1 
		    mew-mlm-guess-alist))
	 (guess-length (length ml-guess)))

    (cond ((= guess-length 1)
	   (car ml-guess))
	  ((> guess-length 1)
	   (mew-mlm-prompt-from-list-with-default 
	    "Mailing list" ml-guess (car ml-guess)))
	  ((= guess-length 0)
	   ;; TODO: should an offer be made to register a new entry in
	   ;;       `mew-mlm-master-alist'?
	   (message "Unable to identify mailing list."))
	  (t 
	   (error "Should not reach this point in code.")))))

(defun mew-mlm-guess-list-from-message-helper1 (alist)
  "Identify mailing list candidates using current message headers and ALIST.
Each key in ALIST is a header name.  Each value in ALIST is a cons
cell.  The cdr is a key from `mew-mlm-master-alist', and the car is 
a substring of a header value that aids in identifying the mailing
list associated with the key.

ALIST is typically `mew-mlm-guess-alist'.

Returns a list of guesses.  Each guess is a key for `mew-mlm-master-alist'.

For most cases the returned list is expected to have a single element.
If there are multiple elements, it is likely that there is some
inconsistency/duplication in `mew-mlm-master-alist' or there is
something fishy about the headers of the current message."
  (let (name header sublist key val ent ret)
    (while alist
      (setq name (car (car alist)))
      (setq sublist (cdr (car alist)))
      (if (stringp name)
	  (progn
	    (setq header (mew-header-get-value name))
	    (if header
		(while sublist
		  (setq key (car (car sublist)))
		  (setq val (cdr (car sublist)))
		  ;; TODO: possible to simplify?
		  (if (and (stringp key) 
			   (string-match key header)
			   (stringp val))
		      (setq ent val))
		  (if ent
		      (progn
			(setq ret (cons ent ret))
			(setq ent nil)))
		  (setq sublist (cdr sublist)))))
	;; problem in alist structure?  name should be a string
	(error "Expected a string, but encountered `%S'." name))
      (setq alist (cdr alist)))
    (mew-uniq-list (nreverse ret))))

(defun mew-mlm-examine-message (function)
  "Examine the current message using FUNCTION.
Returns the return value of FUNCTION, if successeful.

Should only be used in summary mode."
  (interactive) ; for testing
  ;; commented out for using a debugger...
;  (mew-summary-only
;   (mew-summary-msg-or-part
;    (mew-summary-not-in-draft
     (let (fld msg buf ml-key)
       (save-excursion
	 ;; save the cursor position anyway
	 (mew-summary-goto-message)
	 ;; on the message
	 (setq fld (mew-summary-folder-name))
	 (setq msg (mew-summary-message-number)));; msg is never nil
       ;; show message if not displayed
       (if (null mew-summary-buffer-disp-msg)
	   (save-excursion
	     (mew-set-buffer-tmp)
	     (setq buf (current-buffer))
	     (mew-insert-message fld msg mew-cs-autoconv
				 mew-header-reasonable-size)
	     (goto-char (point-min))
	     (if (and (re-search-forward (concat "^$\\|^" mew-subj:) nil t)
		      (not (looking-at "^$")))
		 (let ((med (point)))
		   (forward-line)
		   (mew-header-goto-next)
		   (mew-header-decode-region mew-subj: med (point)))))
	 ;; need to make a cache or a message buffer.
	 (mew-summary-display nil)
	 ;; mew-cache-hit should be first since we want to get 
	 ;; information form the top level header.
	 (setq buf (or (mew-cache-hit fld msg) (mew-buffer-message))))

       (save-excursion
	 (set-buffer buf)
	 (funcall function)))
     ;; commented for debugging
;     )))
  )

(defun mew-mlm-guess-list-from-message ()
  "Guess the mailing list the current message is associated with."
  (interactive) ; for debugging
  (mew-mlm-examine-message (function mew-mlm-guess-list-from-message-helper)))

(defun mew-mlm-make-filter-info (header-name header-value)
  "Constructor for filter information.
Returns a cons cell.  The car is a string representing the header 
name (including colon) and the cdr is a string representing the 
corresponding header value."
  (cons header-name header-value))

;; TODO: consider using some of the extraction functions
(defun mew-mlm-extract-list-id-value (list-id)
  (if (string-match "<\\([^>]+\\)>" list-id)
      (downcase (match-string 1 list-id))
    (error "Unable to extract a value for `%s'." list-id)))

;; TODO: consider using some of the extraction functions
(defun mew-mlm-extract-x-mailing-list-value (x-mailing-list)
  (if (string-match "<\\([^>]+\\)>" x-mailing-list)
      (downcase (match-string 1 x-mailing-list))
    (error "Unable to extract a value for `%s'." x-mailing-list)))

(defun mew-mlm-extract-x-ml-name-value (x-ml-name)
  ;; as-is
  (downcase x-ml-name))

(defun mew-mlm-extract-mailing-list-value (mailing-list)
  ;; unfortunately, kind of messy
  (if (string-match "list \\([^@]+@[^; ]+\\)" mailing-list)
      (downcase (match-string 1 mailing-list))
    (if (string-match "contact \\([^@]+@[^; ]+\\)" mailing-list)
	(downcase (match-string 1 mailing-list))
      (error "Unable to extract a value for `%s'." mailing-list))))

(defun mew-mlm-extract-sender-value (sender)
  ;; as-is
  (downcase (mew-mlm-extract-address-from-string sender)))

(defun mew-mlm-make-entry-from-message-helper ()
  "Extract header info from current message and construct an entry.

This is a helper function for `mew-mlm-make-entry-from-message', 
and assumes that preparations have been made for examining the current 
message (via `mew-mlm-examine-message')."
  (let ((help 
	 (mew-mlm-string-to-list 
	  (or (mew-header-get-value "List-Help:") "")))
	(unsubscribe 
	 (mew-mlm-string-to-list 
	  (or (mew-header-get-value "List-Unsubscribe:") "")))
	(subscribe 
	 (mew-mlm-string-to-list 
	  (or (mew-header-get-value "List-Subscribe:") "")))
	(post 
	 (mew-mlm-string-to-list 
	  (or (mew-header-get-value "List-Post:") "")))
	(owner 
	 (mew-mlm-string-to-list 
	  (or (mew-header-get-value "List-Owner:") "")))
	(archive 
	 (mew-mlm-string-to-list 
	  (or (mew-header-get-value "List-Archive:") "")))
	(list-id 
	 (mew-header-get-value "List-Id:"))
	(x-mailing-list 
	 (mew-header-get-value "X-Mailing-List:"))
	(x-ml-name 
	 (mew-header-get-value "X-ML-Name:"))
	(mailing-list 
	 (mew-header-get-value "Mailing-List:"))
	(sender 
	 (mew-header-get-value "Sender:"))
	filter-info key)

    ;; derive some filter-info
    ;;
    ;; base the filter-info decision on the first header name
    ;; that matches from the following headers (in order):
    ;;
    ;;   List-Id:
    ;;   X-Mailing-List:
    ;;   X-ML-Name:
    ;;   Mailing-List:
    ;;   Sender:
    ;;
    ;; this should cover most cases.
    
    ;; NOTE: the following code depends on the fact that 
    ;;       mew-header-get-value returns nil for no match
    (setq filter-info
	  (cond (list-id
		 (mew-mlm-make-filter-info 
		  "List-Id:" 
		  (mew-mlm-extract-list-id-value list-id)))

		(x-mailing-list
		 (mew-mlm-make-filter-info 
		  "X-Mailing-List:" 
		  (mew-mlm-extract-x-mailing-list-value x-mailing-list)))

		(x-ml-name
		 (mew-mlm-make-filter-info 
		  "X-ML-Name:"
		  (mew-mlm-extract-x-ml-name-value x-ml-name)))

		(mailing-list
		 (mew-mlm-make-filter-info 
		  "Mailing-List:"
		  (mew-mlm-extract-mailing-list-value mailing-list)))

		(sender
		 (mew-mlm-make-filter-info 
		  "Sender:"
		  (mew-mlm-extract-sender-value sender)))

		(t nil)))

    ;; TODO: handle this more gracefully
    ;; check that we got something
    (if (not filter-info)
	(error "Unable to guess filter information."))

    ;; guess a value for key
    (if list-id
	(setq key (mew-mlm-extract-list-id-value list-id))
      (let (to)
	(setq to (mew-header-get-value "To:"))
	(if to
	    (setq key
		  (downcase
		   (mew-mlm-make-list-id-from-address
		    (mew-mlm-extract-address-from-string to))))
	  (setq key ""))))

    ;; using an empty string as a key is a hack?
    (mew-mlm-make-entry key
			help unsubscribe subscribe post owner archive
			"" filter-info nil nil)))

(defun mew-mlm-make-entry-from-message ()
  "Extract header info from message and construct an entry.
Returns a partially-constructed entry (key is empty string) almost
suitable for addition to `mew-mlm-master-alist'."
  (mew-mlm-examine-message (function mew-mlm-make-entry-from-message-helper)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; list action (e.g. post, unsubscribe, etc.) functions

(defun mew-mlm-unsubscribe (ml-key)
  "Create a message to unsubscribe from list identified by ML-KEY.
Supports completion on ML-KEY."
  (interactive
   (list
    (completing-read "Unsubscribe from: " mew-mlm-master-alist nil t)))
  (if (not (equal ml-key ""))
      (let* ((entry (mew-mlm-get-entry ml-key))
	     (unsubscribe (mew-mlm-entry:unsubscribe entry))
	     (n-choices (length unsubscribe))
	     (choice))
	(if (null unsubscribe)
	    (message "No information available for unsubscribing.")
	  (if (listp unsubscribe) ; non-empty list (checked for nil already)
	      (progn
		(cond ((> n-choices 1)
		       (setq choice 
			     (mew-mlm-prompt-from-list-with-default 
			      "Unsubscribe choice" 
			      unsubscribe 
			      (car unsubscribe))))
		      ((= n-choices 1)
		       (setq choice 
			     (car unsubscribe))))
		(mew-browse-url-mailto
		 (mew-mlm-strip-enclosing-angle-brackets 
		  (mew-mlm-extract-abes-from-string choice))))
	    ;; value in mew-mlm-master-alist corrupted?
	    (error "Expected a list value, but got `%S'." unsubscribe))))
    (message "Canceled action.")))

;; TODO: for multiple pieces of posting info, offer choices by completion?
;; TODO: option for prompting user w/ guess before creating message?
(defun mew-mlm-post-to-this-list ()
  "Create a message to post to \"this list\".
\"This list\" refers to the list associated with the current message,
if any."
  (interactive)
  (mew-summary-only
   ;; TODO: if guessing fails, prompt user w/ list choices?
   (let* ((ml-key (mew-mlm-guess-list-from-message))
	  (post (mew-mlm-entry:post (mew-mlm-get-entry ml-key))))
     (if (listp post)
	 (mew-browse-url-mailto 
	  (mew-mlm-strip-enclosing-angle-brackets 
	   (mew-mlm-extract-abes-from-string (car post))))
       ;; TODO: could try to guess post info from To: or Cc: header...
       ;; TODO: could also offer to some how learn the correct posting info
       (message "No post information available.")))
   ) ; comment out for debugging
  )

(defun mew-mlm-unsubscribe-from-this-list ()
  "Create a message to unsubscribe from \"this list\"."
  (interactive)
  (mew-summary-only
   (let ((ml-key (mew-mlm-guess-list-from-message))
	  unsubscribe)
     (if (not ml-key)
	 (message "Could not guess list associated with the current message.")
       (progn
	 (setq unsubscribe (mew-mlm-entry:unsubscribe 
			    (mew-mlm-get-entry ml-key)))
	 (if (listp unsubscribe)
	     (mew-browse-url-mailto
	      (mew-mlm-strip-enclosing-angle-brackets 
	       (mew-mlm-extract-abes-from-string (car unsubscribe))))
	   (message "No unsubscribe information availabe.")))))
   ) ; comment out for debugging
  )
   

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; intialization function

(defun mew-mlm-setup ()
  "Initialization of this package."
  ;; initialize `mew-mlm-master-alist'
  (mew-mlm-load-master-alist)
  ;; build `mew-mlm-guess-alist'
  (setq mew-mlm-guess-alist (mew-mlm-make-guess-alist))
  ;; save when quitting
  (add-hook 'mew-quit-hook 'mew-mlm-save-master-alist))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; main ;-)

(mew-mlm-setup)

(provide 'mew-mlm)